/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import tactic well_order logic.small

open_locale classical
noncomputable theory

universes u v

namespace my

@[ext]
structure well_ordered_type :=
(type : Type u)
[well_order_type : well_order type]

instance : has_coe_to_sort well_ordered_type.{u} (Type u) := ⟨well_ordered_type.type⟩

instance well_order_well_ordered_type (α : well_ordered_type.{u}) : well_order α :=
well_ordered_type.well_order_type _

instance order_iso_setoid : setoid (well_ordered_type.{u}) :=
{ r := λ α β, nonempty (α ≃o β),
  iseqv := ⟨λ α, ⟨order_iso.refl _⟩, λ α β ⟨f⟩, ⟨f.symm⟩, λ α β γ ⟨f⟩ ⟨g⟩, ⟨f.trans g⟩⟩ }

def ordinal := quotient my.order_iso_setoid.{u}
def order_type (α : Type u) [well_order α] : ordinal.{u} := ⟦⟨α⟩⟧

instance : linear_order ordinal.{u} :=
{ le := quotient.lift₂ (λ α β, ↥α ≺ ↥β)
  begin
    rintro α β α' β' ⟨f⟩ ⟨g⟩,
    simp only [eq_iff_iff, iis_iff_exists_strict_mono],
    refine ⟨_, _⟩,
    { rintro ⟨u, hu, hu'⟩,
      refine ⟨(g ∘ u) ∘ f.symm, g.strict_mono.comp (hu.comp f.symm.strict_mono), _⟩,
      rwa [f.symm.surjective.range_comp, set.range_comp, initial_segment_of_order_iso] },
    { rintro ⟨u, hu, hu'⟩,
      refine ⟨(g.symm ∘ u) ∘ f, (g.symm.strict_mono.comp hu).comp f.strict_mono, _⟩,
      rwa [f.surjective.range_comp, set.range_comp, initial_segment_of_order_iso] }
  end,
  le_refl := by { rintro ⟨α⟩, exact well_order_refl },
  le_trans := by { rintro ⟨α⟩ ⟨β⟩ ⟨γ⟩, exact well_order_trans },
  le_antisymm := by { rintro ⟨α⟩ ⟨β⟩ hαβ hβα, exact quotient.sound (well_order_antisymm hαβ hβα) },
  le_total := by { rintro ⟨α⟩ ⟨β⟩, exact well_order_total },
  decidable_le := infer_instance,
  decidable_eq := infer_instance,
  decidable_lt := infer_instance }

@[simp] lemma mk_eq_order_type {α : Type u} [well_order α] : (⟦⟨α⟩⟧ : ordinal.{u}) = order_type α :=
rfl

@[simp] lemma quot_mk_eq_order_type {α : well_ordered_type.{u}} : quot.mk setoid.r α = order_type α :=
begin
  rw [order_type],
  congr' 1,
  ext; refl
end

@[simp] lemma order_type_le_iff {α β : Type u} [well_order α] [well_order β] : order_type α ≤ order_type β ↔ α ≺ β :=
iff.rfl

lemma order_type_eq_iff {α β : Type u} [well_order α] [well_order β] : order_type α = order_type β ↔ nonempty (α ≃o β) :=
quotient.eq

lemma order_type_lt_iff {α β : Type u} [well_order α] [well_order β] :
  order_type α < order_type β ↔ ∃ (f : α → β), strict_mono f ∧ ∃ y, set.range f = I y :=
begin
  rw [lt_iff_le_and_ne, order_type_le_iff, iis_iff_exists_strict_mono],
  refine ⟨_, _⟩,
  { rintro ⟨⟨f, ⟨hf, hf'⟩⟩, h⟩,
    refine ⟨f, hf, _⟩,
    rcases initial_segment_eq hf' with (hrf|h),
    { exact false.elim (h (order_type_eq_iff.2 ⟨hf.order_iso_of_surjective _ (set.range_iff_surjective.1 hrf)⟩)) },
    { exact h } },
  { rintro ⟨f, hf, ⟨y, hy⟩⟩,
    refine ⟨⟨f, hf, hy.symm ▸ initial_segment_I _⟩, λ h, _⟩,
    obtain ⟨g⟩ := order_type_eq_iff.1 h,
    have := surjective_of_initial_segment_range (f ∘ g.symm) (hf.comp g.symm.strict_mono) _,
    { rw [←set.range_iff_surjective, g.symm.surjective.range_comp, hy] at this,
      exact I_ne_univ _ this },
    { rw [g.symm.surjective.range_comp, hy],
      exact initial_segment_I _ } }
end

def order_iso_I_order_type (α : Type u) [well_order α] : α ≃o I (order_type α) :=
begin
  refine strict_mono.order_iso_of_surjective
    (λ x, ⟨order_type (I x), order_type_lt_iff.2 ⟨subtype.val, λ x y, id, ⟨x, subtype.range_val⟩⟩⟩) _ _,
  { intros x y hxy,
    simp only [subtype.mk_lt_mk, order_type_lt_iff],
    refine ⟨λ x, ⟨x.1, lt_trans x.2 hxy⟩, λ x y, id, ⟨⟨x, hxy⟩, set.ext _⟩⟩,
    rintro ⟨z, hz⟩,
    refine ⟨_, _⟩,
    { rintro ⟨w, hw⟩,
      simp only [subtype.mk_eq_mk, subtype.val_eq_coe] at hw,
      subst hw,
      exact w.2 },
    { rintro (hz' : z < x),
      exact ⟨⟨z, hz'⟩, rfl⟩ } },
  { rintro ⟨⟨β⟩, hβ⟩,
    simp only [quot_mk_eq_order_type, mem_I, order_type_lt_iff] at hβ,
    rcases hβ with ⟨f, hf, ⟨y, hy⟩⟩,
    refine ⟨y, _⟩,
    simp only [quot_mk_eq_order_type, subtype.mk_eq_mk, order_type_eq_iff],
    refine ⟨order_iso.symm _⟩,
    rw ←hy,
    exact hf.order_iso _ }
end

lemma small_initial_segment : ∀ (α : ordinal.{u}), small.{u} (I α) :=
by { rintro ⟨α⟩, exact ⟨⟨α, ⟨(order_iso_I_order_type α).symm.to_equiv⟩⟩⟩ }

instance well_order_ordinals : well_order ordinal.{u} :=
{ exists_min :=
  begin
    rintro S ⟨⟨α⟩, hα⟩,
    simp only [quot_mk_eq_order_type] at hα,
    by_cases h : ∀ β ∈ S, order_type α ≤ β,
    { exact ⟨order_type α, hα, h⟩ },
    { simp only [exists_prop, not_le, not_forall] at h,
      rcases h with ⟨β, hβ, hβα⟩,
      let T : set (I (order_type α)) := { γ | γ.1 ∈ S },
      let f := (order_iso_I_order_type α).symm,
      have hT : set.nonempty (f '' T) := ⟨f ⟨β, hβα⟩, ⟨⟨β, hβα⟩, ⟨hβ, rfl⟩⟩⟩,
      obtain ⟨a, ⟨⟨δ, hδ'⟩, ⟨hδ'', rfl⟩⟩, ha'⟩ := exists_min _ hT,
      refine ⟨δ, hδ'', λ ε hε, _⟩,
      by_cases hε' : ε < order_type α,
      { exact f.le_iff_le.1 (ha' (f ⟨ε, hε'⟩) ⟨⟨ε, hε'⟩, ⟨hε, rfl⟩⟩) },
      { exact le_of_lt (lt_of_lt_of_le hδ' (not_lt.1 hε')) } }
  end,
  ..(infer_instance : linear_order ordinal.{u}) }

def well_order.pullback {α : Type u} {β : Type v} [well_order β] (f : α → β) (hf : function.injective f) : well_order α :=
{ le := λ x y, f x ≤ f y,
  le_refl := λ x, le_refl _,
  le_trans := λ x y z, le_trans,
  le_antisymm := λ x y hxy hyx, hf $ le_antisymm hxy hyx,
  le_total := λ x y, @le_total _ _ (f x) (f y),
  decidable_le := by apply_instance,
  decidable_eq := by apply_instance,
  decidable_lt := by apply_instance,
  exists_min :=
  begin
    rintro S ⟨s, hs⟩,
    obtain ⟨b, ⟨a, ⟨ha, rfl⟩⟩, ha'⟩ := exists_min (f '' S) ⟨f s, ⟨s, hs, rfl⟩⟩,
    exact ⟨a, ha, λ b hb, ha' (f b) ⟨b, hb, rfl⟩⟩
  end }

theorem burali_forti : ¬small.{u} ordinal.{u} :=
begin
  rintro ⟨α, ⟨f⟩⟩,
  letI := well_order.pullback f.symm f.symm.injective,
  let g : ordinal.{u} ≃o α := f.to_order_iso (λ x y hxy, _) (λ x y, id),
  { exact I_ne_univ _ (iis_self (I (order_type α)) (initial_segment_I _) ⟨g.trans (order_iso_I_order_type α)⟩) },
  { rwa [←f.symm_apply_apply x, ←f.symm_apply_apply y] at hxy }
end

section supremum
variables {J : Type u} (α : J → ordinal.{u})

theorem exists_supremum : ∃ β : ordinal.{u}, (∀ i, α i ≤ β) ∧ ∀ γ, (∀ i, α i ≤ γ) → β ≤ γ :=
begin
  suffices : ∃ β' : ordinal.{u}, ∀ i, α i ≤ β',
  { rcases this with ⟨β', hβ'⟩,
    obtain ⟨β, hβ₁, hβ₂⟩ := exists_min { γ | ∀ i, α i ≤ γ } ⟨β', hβ'⟩,
    exact ⟨β, hβ₁, hβ₂⟩ },
  have : ∀ i, ∃ (γ : well_ordered_type.{u}), ⟦γ⟧ = α i := λ i, quotient.exists_rep _,
  choose α' h using this,
  let Α : Type u := Σ i, α' i,
  letI setoid_Α : setoid Α := ⟨λ x y, (order_iso_I_order_type (α' x.1) x.2 : ordinal.{u}) = order_iso_I_order_type (α' y.1) y.2, _⟩,
  { let Β : Type u := quotient setoid_Α,
    let f : Β → ordinal.{u} := quotient.lift (λ (x : Α), (order_iso_I_order_type (α' x.1) x.2 : ordinal.{u})) (λ x y, id),
    have hf : function.injective f,
    { rintro ⟨x⟩ ⟨y⟩ hxy,
      exact quot.sound hxy },
    letI : well_order Β := well_order.pullback f hf,
    refine ⟨order_type Β, λ i, _⟩,
    rw ←h,
    change order_type (α' i) ≤ order_type Β,
    rw [order_type_le_iff, iis_iff_exists_strict_mono],
    refine ⟨λ x, ⟦⟨i, x⟩⟧, _, _⟩,
    { rintro x y hxy,
      change order_iso_I_order_type (α' i) x < order_iso_I_order_type (α' i) y,
      rwa order_iso.lt_iff_lt },
    { rintro x ⟨y, rfl⟩ ⟨z⟩ (hz : (order_iso_I_order_type (α' z.1) z.2 : ordinal.{u}) < order_iso_I_order_type (α' i) y),
      let z' : I (order_type (α' i)) := ⟨order_iso_I_order_type (α' z.1) z.2, hz.trans (order_iso_I_order_type (α' i) y).2⟩,
      refine ⟨(order_iso_I_order_type (α' i)).symm z', quot.sound _⟩,
      simp only [order_iso.apply_symm_apply, subtype.coe_mk, setoid.r] } },
  { refine ⟨_, _, _⟩,
    { rintro ⟨x, hx⟩, constructor },
    { rintro ⟨x, hx⟩ ⟨y, hy⟩ hxy,
      exact hxy.symm },
    { rintro ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩ hxy hyz,
      exact hxy.trans hyz } }
end

def supremum : ordinal.{u} := classical.some $ exists_supremum α
lemma le_supremum : ∀ i, α i ≤ supremum α := (classical.some_spec $ exists_supremum α).1
lemma supremum_le : ∀ γ, (∀ i, α i ≤ γ) → supremum α ≤ γ := (classical.some_spec $ exists_supremum α).2

end supremum

theorem hartog {α : Type u} : ∃ {β : well_ordered_type.{u}}, ¬∃ (f : β → α), function.injective f :=
begin
  let K := Σ (Y : set α), well_order Y,
  let g : K → ordinal.{u} := λ Y, ⟦@well_ordered_type.mk Y.1 Y.2⟧,
  have hg : initial_segment (set.range g),
  { rintro x ⟨⟨y, hy⟩, rfl⟩ ⟨⟨z, well_order_z⟩⟩ hzy,
    simp [g] at hzy,
    resetI,
    dsimp only at hzy,
    obtain ⟨f, ⟨hf, ⟨q, hq⟩⟩⟩ := order_type_lt_iff.1 hzy,
    let Z := set.range (subtype.val ∘ f),
    have : function.injective (subtype.val ∘ f) := subtype.val_injective.comp hf.injective,
    letI well_order_Z : well_order Z := well_order.pullback (equiv.of_injective _ this).symm (equiv.of_injective _ this).symm.injective,
    refine ⟨⟨Z, well_order_Z⟩, order_type_eq_iff.2 ⟨equiv.to_order_iso (equiv.of_injective _ this).symm (λ a b, id) _⟩⟩,
    rintros a b hab,
    rwa [←(equiv.of_injective _ this).symm_apply_apply a, ←(equiv.of_injective _ this).symm_apply_apply b] at hab },
  rcases initial_segment_eq hg with (h|⟨⟨x⟩, hx⟩),
  { exact false.elim (burali_forti.{u} (small_of_surjective (set.range_iff_surjective.1 h))) },
  { refine ⟨x, _⟩,
    rintro ⟨f, hf⟩,
    have hlt : ∀ (Y : set α) [well_order Y], by exactI order_type Y < order_type x,
    { introsI Y hY,
      have : order_type Y ∈ set.range g := ⟨⟨Y, hY⟩, rfl⟩,
      simpa only [hx] using this },
    have F : x ≃ set.range f := equiv.of_injective f hf,
    letI : well_order (set.range f) := well_order.pullback F.symm F.symm.injective,
    suffices h : nonempty (set.range f ≃o x),
    { refine ne_of_lt (hlt (set.range f)) (quotient.sound h) },
    refine ⟨F.symm.to_order_iso (λ a b, id) (λ a b hab, _)⟩,
    simp only [equiv.symm_symm],
    rwa [←F.symm_apply_apply a, ←F.symm_apply_apply b] at hab }
end

end my


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import data.real.nnreal
import ring_theory.valuation.basic

/-!
# Rank one valuations

We define rank one valuations and discrete valuations

## Main Definitions
* `is_rank_one` : A valuation has rank one if it is nontrivial and its image is contained in `ℝ≥0`.
* `is_discrete` : A valuation is discrete if it is nontrivial and its image is contained in
  `with_zero (multiplicative ℤ)`.

## Tags

valuation, rank one, discrete, with_zero
-/

noncomputable theory

open function multiplicative

open_locale nnreal

variables {R : Type*} [ring R] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

lemma mult_with_top_R_zero : multiplicative.of_add (order_dual.to_dual ⊤) =
  (0 : multiplicative (with_top ℝ)ᵒᵈ) := rfl

section is_rank_one

/-- A valuation has rank one if it is nontrivial and its image is contained in `ℝ≥0`. -/
class is_rank_one (v : valuation R Γ₀)  :=
(hom : Γ₀ →*₀ ℝ≥0)
(strict_mono : strict_mono hom)
(nontrivial : ∃ r : R, v r ≠ 0 ∧ v r ≠ 1)

/-- If `v` is a rank one valuation and `x : Γ₀` has image `0` under `is_rank_one.hom v`, then
  `x = 0`. -/
lemma zero_of_is_rank_one_hom_zero (v : valuation R Γ₀) [is_rank_one v] {x : Γ₀}
 (hx : is_rank_one.hom v x = 0) : x = 0 :=
begin
  have hx0 : 0 ≤ x := zero_le',
  cases le_iff_lt_or_eq.mp hx0 with h_lt h_eq,
  { have hs := is_rank_one.strict_mono h_lt,
    rw [map_zero, hx] at hs,
    exact absurd hs not_lt_zero', },
  { exact h_eq.symm }
end

/-- If `v` is a rank one valuation, then`x : Γ₀` has image `0` under `is_rank_one.hom v` if and
  only if `x = 0`. -/
@[simp] lemma is_rank_one_hom_eq_zero_iff (v : valuation R Γ₀) [hv : is_rank_one v] {x : Γ₀} :
  is_rank_one.hom v x = 0 ↔  x = 0 :=
⟨λ h, zero_of_is_rank_one_hom_zero v h, λ h, by rw [h, map_zero]⟩

/-- A nontrivial unit of `Γ₀`, given that there exists a rank one valuation `v : valuation R Γ₀`. -/
def is_rank_one_unit (v : valuation R Γ₀) [hv : is_rank_one v] : Γ₀ˣ :=
units.mk0 (v (classical.some hv.nontrivial)) (classical.some_spec hv.nontrivial).1

/-- A proof that `is_rank_one_unit v ≠ 1`. -/
lemma is_rank_one_unit_ne_one (v : valuation R Γ₀) [hv : is_rank_one v] :
  is_rank_one_unit v ≠ 1 :=
begin
  rw [ne.def, ← units.eq_iff, units.coe_one],
  exact (classical.some_spec hv.nontrivial).2,
end

/-- A valuation is discrete if it is nontrivial and its image is contained in
  `with_zero (multiplicative ℤ)`. -/
class is_discrete (v : valuation R Γ₀) :=
(hom : Γ₀ →*₀ with_zero (multiplicative ℤ))
(strict_mono : strict_mono hom)
(nontrivial : ∃ r : R, v r ≠ 0 ∧ v r ≠ 1)

end is_rank_one

-- In this section, we develop some API for `with_zero`, to be PR'd to mathlib.
namespace with_zero

variables {G H : Type*}

/-- A term of `G` that represents a nonzero term of `with_zero G`. -/
def some {x : with_zero G} (hx : x ≠ 0) : G := classical.some (ne_zero_iff_exists.mp hx)

lemma some_spec {x : with_zero G} (hx : x ≠ 0) : ↑(some hx) = x :=
classical.some_spec (ne_zero_iff_exists.mp hx)

@[simp] lemma some_coe {g : G} : some (@coe_ne_zero G g) = g :=
coe_inj.mp (classical.some_spec (ne_zero_iff_exists.mp (@coe_ne_zero G g)))

/-- If `G` is a monoid and `x y : with_zero G` have a nonzero product, then
  `some hxy = some (left_ne_zero_of_mul hxy) * some (right_ne_zero_of_mul hxy)`  -/
lemma some_mul [monoid G] {x y : with_zero G} (hxy : x * y ≠ 0) :
  some hxy = some (left_ne_zero_of_mul hxy) * some (right_ne_zero_of_mul hxy) :=
by rw [← coe_inj, coe_mul, some_spec, some_spec, some_spec]

/-- The monoid_with_zero homomorphism `with_zero G →* with_zero H` induced by a monoid homomorphism
  `f : G →* H`. -/
def coe_monoid_hom [monoid G] [monoid H] (f : G →* H) [decidable_eq (with_zero G)] :
  with_zero G →*₀ with_zero H :=
{ to_fun := λ x, if hx : x = 0 then 0 else f (some hx),
  map_zero' := by simp only [dif_pos],
  map_one' :=
  begin
    have h1 : (1 : with_zero G) ≠ 0 := one_ne_zero,
    have h := (classical.some_spec (ne_zero_iff_exists.mp h1)),
    rw dif_neg h1,
    simp_rw ← coe_one at h ⊢,
    rw [coe_inj, some_coe, f.map_one],
  end,
  map_mul' := λ x y,
  begin
    by_cases hxy : x * y = 0,
    { rw dif_pos hxy,
      cases zero_eq_mul.mp (eq.symm hxy) with hx hy,
      { rw [dif_pos hx, zero_mul] },
      { rw [dif_pos hy, mul_zero] }},
    { rw [dif_neg hxy, dif_neg (left_ne_zero_of_mul hxy), dif_neg (right_ne_zero_of_mul hxy),
        ← coe_mul, coe_inj, ← f.map_mul, some_mul hxy] }
  end }

  end with_zero


import Lean4Axiomatic.AbstractAlgebra
import Lean4Axiomatic.Rational.Addition

/-! # Rational numbers: multiplication -/

namespace Lean4Axiomatic.Rational

/-! ## Axioms -/

/-- Operations pertaining to rational number multiplication. -/
class Multiplication.Ops (ℚ : Type) :=
  /-- Multiplication of rational numbers. -/
  mul : ℚ → ℚ → ℚ

export Multiplication.Ops (mul)

/-- Enables the use of the `· * ·` operator for multiplication. -/
instance mul_op_inst {ℚ : Type} [Multiplication.Ops ℚ] : Mul ℚ := {
  mul := mul
}

/-- Properties of rational number multiplication. -/
class Multiplication.Props
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Ops ℚ]
    :=
  /-- Multiplication respects equivalence over its left operand. -/
  mul_substL {p₁ p₂ q : ℚ} : p₁ ≃ p₂ → p₁ * q ≃ p₂ * q

  /-- Multiplication respects equivalence over its right operand. -/
  mul_substR {p₁ p₂ q : ℚ} : p₁ ≃ p₂ → q * p₁ ≃ q * p₂

  /-- Multiplication is consistent with its integer equivalent. -/
  mul_compat_from_integer {a b : ℤ} : ((a * b : ℤ) : ℚ) ≃ (a : ℚ) * (b : ℚ)

  /-- Multiplication is commutative. -/
  mul_comm {p q : ℚ} : p * q ≃ q * p

  /-- Multiplication is associative. -/
  mul_assoc {p q r : ℚ} : (p * q) * r ≃ p * (q * r)

  /-- One is a left multiplicative identity. -/
  mul_identL {p : ℚ} : 1 * p ≃ p

  /-- One is a right multiplicative identity. -/
  mul_identR {p : ℚ} : p * 1 ≃ p

  /-- Multiplication on the left distributes over addition. -/
  mul_distribL {p q r : ℚ} : p * (q + r) ≃ p * q + p * r

  /-- Multiplication on the right distributes over addition. -/
  mul_distribR {p q r : ℚ} : (q + r) * p ≃ q * p + r * p

export Multiplication.Props (
  mul_assoc mul_comm mul_compat_from_integer mul_distribL mul_distribR
  mul_identL mul_identR mul_substL mul_substR
)

/-- All axioms of multiplication for rational numbers. -/
class Multiplication
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ]
    :=
  toOps : Multiplication.Ops ℚ
  toProps : Multiplication.Props ℚ

attribute [instance] Multiplication.toOps
attribute [instance] Multiplication.toProps

/-! ## Derived properties -/

variable {ℕ ℤ : Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
variable {ℚ : Type} [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Multiplication ℚ]

/-- Enables the use of `AA.substL`, `AA.substR`, etc. for multiplication. -/
instance mul_subst_inst
    : AA.Substitutive₂ (α := ℚ) (· * ·) AA.tc (· ≃ ·) (· ≃ ·)
    := {
  substitutiveL := { subst₂ := λ (_ : True) => mul_substL }
  substitutiveR := { subst₂ := λ (_ : True) => mul_substR }
}

/-- Enables the use of `AA.comm` for commutativity of multiplication. -/
instance mul_comm_inst : AA.Commutative (α := ℚ) (· * ·) := {
  comm := mul_comm
}

/-- Enables the use of `AA.assoc` for associativity of multiplication. -/
instance mul_assoc_inst : AA.Associative (α := ℚ) (· * ·) := {
  assoc := mul_assoc
}

/--
Holds for the rational numbers that are square roots of unity, i.e. that result
in `1` when squared.

See `Integer.Sqrt1` for details on why this is a useful predicate.
-/
class inductive Sqrt1 (p : ℚ) : Prop :=
| /--
  Create `Sqrt1` for the rational equivalent of an integer square root of
  unity.
  -/
  from_integer_intro (a : ℤ) (sqrt1 : Integer.Sqrt1 a) (eqv : p ≃ (a : ℚ))

/-- Alternative to `Sqrt1.from_integer_intro` that infers more arguments. -/
def Sqrt1.from_integer
    {a : ℤ} {p : ℚ} [Integer.Sqrt1 a] : p ≃ (a : ℚ) → Sqrt1 p
    :=
  from_integer_intro a ‹Integer.Sqrt1 a›

/--
The defining property of square roots of unity.

**Proof intuition**: Expand the definition of `Sqrt1` to obtain the underlying
integer. Then show the property is preserved by conversion to rational numbers.
-/
theorem Sqrt1.elim {p : ℚ} : Sqrt1 p → p * p ≃ 1 := by
  intro (_ : Sqrt1 p)
  show p * p ≃ 1
  have (Sqrt1.from_integer_intro (a : ℤ) (_ : Integer.Sqrt1 a) eqv) :=
    ‹Sqrt1 p›
  have : p ≃ (a : ℚ) := eqv
  have : p * p ≃ 1 := calc
    p * p             ≃ _ := mul_substL ‹p ≃ (a : ℚ)›
    (a : ℚ) * p       ≃ _ := mul_substR ‹p ≃ (a : ℚ)›
    (a : ℚ) * (a : ℚ) ≃ _ := eqv_symm mul_compat_from_integer
    ((a * a : ℤ) : ℚ) ≃ _ := from_integer_subst ‹Integer.Sqrt1 a›.elim
    (1 : ℚ)           ≃ _ := eqv_refl
    1                 ≃ _ := eqv_refl
  exact this

/--
The `Sqrt1` predicate respects equivalence of rational numbers.

**Property intuition**: This must hold for `Sqrt1` to be a valid predicate.

**Proof intuition**: Expand the definition of `Sqrt1`; the result follows by
substitution on the underlying equivalence.
-/
theorem sqrt1_subst {p₁ p₂ : ℚ} : p₁ ≃ p₂ → Sqrt1 p₁ → Sqrt1 p₂ := by
  intro (_ : p₁ ≃ p₂) (_ : Sqrt1 p₁)
  show Sqrt1 p₂
  have (Sqrt1.from_integer_intro (a : ℤ) (_ : Integer.Sqrt1 a) eqv) :=
    ‹Sqrt1 p₁›
  have : p₁ ≃ (a : ℚ) := eqv
  have : p₂ ≃ (a : ℚ) := AA.substLFn ‹p₁ ≃ p₂› this
  have : Sqrt1 p₂ := Sqrt1.from_integer_intro a ‹Integer.Sqrt1 a› this
  exact this

/--
An integer square root of unity keeps that designation when converted to a
rational number.

**Property intuition**: Multiplication is preserved by integer conversion, and
the square root of unity property is defined in terms of multiplication, so we
expect it to be preserved as well.

**Proof intuition**: `Sqrt1` for rationals already delegates to the definition
for integers; expand it and use that connection.
-/
theorem from_integer_preserves_sqrt1
    {a : ℤ} : Sqrt1 (a : ℚ) ↔ Integer.Sqrt1 a := by
  apply Iff.intro
  case mp =>
    intro (_ : Sqrt1 (a : ℚ))
    show Integer.Sqrt1 a
    have (Sqrt1.from_integer_intro (b : ℤ) (_ : Integer.Sqrt1 b) eqv) :=
      ‹Sqrt1 (a : ℚ)›
    have : (b : ℚ) ≃ (a : ℚ) := eqv_symm eqv
    have : b ≃ a := from_integer_inject this
    have : Integer.Sqrt1 a := Integer.sqrt1_subst this ‹Integer.Sqrt1 b›
    exact this
  case mpr =>
    intro (_ : Integer.Sqrt1 a)
    show Sqrt1 (a : ℚ)
    exact Sqrt1.from_integer eqv_refl

/--
The rational number `1` is a square root of unity.

**Property and proof intuition**: This is a trivial corollary of the proof that
integer square roots of unity are also rational square roots of unity.
-/
instance sqrt1_one : Sqrt1 (1 : ℚ) :=
  from_integer_preserves_sqrt1.mpr Integer.sqrt1_one

end Lean4Axiomatic.Rational


import analysis.real init.classical tactic.norm_num

namespace M1F

def floor_set (x : ℝ) : set ℝ := { y : ℝ | y ≤ x ∧  ∃ n : ℤ, y = ↑n }

lemma floor_set_nonempty (x : ℝ) : ∃ s : ℝ, s ∈ floor_set x :=
let ⟨m,Hm⟩ := exists_lt_nat (-x) in
⟨-m,begin
  split,
  { exact le_of_lt (neg_lt.1 Hm)},
  existsi (-(m:ℤ)),
  simp,
end⟩

lemma floor_set_bounded (x : ℝ) : ∃ B : ℝ, B ∈ upper_bounds (floor_set x) :=
⟨x,λ _ H,H.left⟩

theorem exists_real_floor (x : ℝ) : ∃ (n : ℤ), ↑n ≤ x ∧ x < n+1 :=
begin
let S :=floor_set x,
have H₁ := floor_set_nonempty x,
cases H₁ with z Hz,
have HB : x ∈ upper_bounds (floor_set x)
have H₂ := floor_set_bounded x,
cases H₂ with B HB,

have lub_exists := exists_supremum_real Hz HB,
cases lub_exists with m Hm,

have H1 : ∃ s : ℝ, s ∈ S := let ⟨m,Hm⟩ := exists_lt_nat (-x) in
⟨-m,begin
  split,
  { exact le_of_lt (neg_lt.1 Hm)},
  existsi (-(m:ℤ)),
  simp,
end⟩

end

theorem floor_real_exists : ∀ (x : ℝ), ∃ (n : ℤ), ↑n ≤ x ∧ x < n+1 :=
begin
intro x,
have H : ∃ (q : ℚ), x < ↑q ∧ ↑q < x + 1,
  exact @exists_rat_btwn x (x+1) (by simp [zero_lt_one]),
cases H with q Hq,
cases classical.em (x < rat.floor q) with Hb Hs,
  exact ⟨rat.floor q - 1,
  begin
  split,
    rw [int.cast_sub,int.cast_one],
    apply sub_left_le_of_le_add _,
    rw [add_comm],
    suffices H7 : (↑q:real) ≤ x+1,
      exact calc (↑(rat.floor q):ℝ) = (↑((rat.floor q):ℚ):ℝ) : by simp
      ... ≤ (↑q:ℝ) : rat.cast_le.mpr (rat.floor_le q)
      ... ≤ x+1 : H7,
    exact le_of_lt Hq.right,
  rwa [int.cast_sub,int.cast_one,sub_add_cancel],
  end
  ⟩,

  exact ⟨rat.floor q,
    begin
    split,
      have H : (x < ↑(rat.floor q)) ∨ (x ≥ ↑(rat.floor q)),
        exact lt_or_ge x ↑(rat.floor q),
      cases H with F T,
        exact false.elim (Hs F),
      exact T,

    clear Hs,
    have H1 : x < ↑q,
      { exact Hq.left },
    clear Hq,

      -- insanity starts here

    suffices H2 : q < ↑((rat.floor q)+(1:ℤ)),
      exact calc x < (q:ℝ) : H1
      ... < ((((rat.floor q + 1):ℤ):ℚ):ℝ) : rat.cast_lt.2 H2
      ... = (((rat.floor q + 1):ℤ):ℝ) : by simp
      ... = ((rat.floor q):ℝ)+((1:ℤ):ℝ) : int.cast_add _ _
      ... = ↑(rat.floor q) + 1 : by rw [int.cast_one],
    clear H1,
    exact rat.lt_succ_floor q,
  end⟩
end

lemma rational_half_not_an_integer : ¬ (∃ y : ℤ, 1/2 = (y:rat)) :=
begin
apply not_exists.2,
rw [one_div_eq_inv],
assume x:ℤ,
intro H,
have H6 : ((1:ℤ):ℚ)=((2:ℤ):ℚ)*x,
  exact calc
  ((1:ℤ):ℚ) = (1:ℚ) : by simp
  ... = (2:ℚ)* 2⁻¹ : eq.symm (mul_inv_cancel (by norm_num))
  ... = (2*x) : by rw[H],
clear H,
rw [←int.cast_mul,int.cast_inj] at H6,
have H : (1:ℤ) = 0,
exact calc (1:ℤ) = 1 % 2 : eq.symm (int.mod_eq_of_lt (by norm_num) (by norm_num))
... = (2*x) % 2 : eq.symm (by rw [←H6])
... = 0 : by simp,
revert H,
norm_num,
end

-- set_option pp.all true

lemma real_half_not_an_integer : ¬ (∃ y : ℤ, ((1/2):ℝ) = (y:ℝ)) :=
begin
assume H_real : (∃ y : ℤ, ((1/2):ℝ) = (y:ℝ)),
cases H_real with a Ha,
suffices H2 : ((1:ℤ):ℝ) = ((2:ℤ):ℝ)*((a:ℤ):ℝ),
  rw [←int.cast_mul,int.cast_inj] at H2,
  have H8 : (2*a) % 2 = 0,
    simp [@int.add_mul_mod_self 0],
  have H9 : (1:int) % 2 = 0,
    apply @eq.subst ℤ  (λ t, t%2 =0) _ _ (eq.symm H2) H8,
  have H10 : (1:int) % 2 ≠ 0,
    exact dec_trivial,
  contradiction,
have H20: (2:ℝ) ≠ 0, {norm_num},
have H1 : (↑a:ℝ) * 2 = 1,
  exact mul_eq_of_eq_div (a:ℝ) 1 H20 (eq.symm Ha),
have H2 : 1 = 2 * (↑a:ℝ),
  rw [mul_comm] at H1,
  exact eq.symm (H1),
have H3 : (1:ℝ) = ((1:ℤ):ℝ), by simp,
have H4 : (2:ℝ) = ((2:ℤ):ℝ), by simp,
rwa [←H3,←H4],
end

definition is_irrational (x : ℝ) := ¬ (∃ (q : ℚ), (q:ℝ) = x)

end M1F


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Joseph Myers
-/

import data.complex.exponential
import analysis.special_functions.log.deriv

/-!
# Bounds on specific values of the exponential
-/
namespace real

open is_absolute_value finset cau_seq complex

lemma exp_one_near_10 : |exp 1 - 2244083/825552| ≤ 1/10^10 :=
begin
  apply exp_approx_start,
  iterate 13 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_near_20 : |exp 1 - 363916618873/133877442384| ≤ 1/10^20 :=
begin
  apply exp_approx_start,
  iterate 21 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_gt_d9 : 2.7182818283 < exp 1 :=
lt_of_lt_of_le (by norm_num) (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2)

lemma exp_one_lt_d9 : exp 1 < 2.7182818286 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) (by norm_num)

lemma exp_neg_one_gt_d9 : 0.36787944116 < exp (-1) :=
begin
  rw [exp_neg, lt_inv _ (exp_pos _)],
  refine lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) _,
  all_goals {norm_num},
end

lemma exp_neg_one_lt_d9 : exp (-1) < 0.36787944120 :=
begin
  rw [exp_neg, inv_lt (exp_pos _)],
  refine lt_of_lt_of_le _ (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2),
  all_goals {norm_num},
end

lemma log_two_near_10 : |log 2 - 287209 / 414355| ≤ 1/10^10 :=
begin
  suffices : |log 2 - 287209 / 414355| ≤ 1/17179869184 + (1/10^10 - 1/2^34),
  { norm_num1 at *,
    assumption },
  have t : |(2⁻¹ : ℝ)| = 2⁻¹,
  { rw abs_of_pos, norm_num },
  have z := real.abs_log_sub_add_sum_range_le (show |(2⁻¹ : ℝ)| < 1, by { rw t, norm_num }) 34,
  rw t at z,
  norm_num1 at z,
  rw [one_div (2:ℝ), log_inv, ←sub_eq_add_neg, _root_.abs_sub_comm] at z,
  apply le_trans (_root_.abs_sub_le _ _ _) (add_le_add z _),
  simp_rw [sum_range_succ],
  norm_num,
  rw abs_of_pos;
  norm_num
end

lemma log_two_gt_d9 : 0.6931471803 < log 2 :=
lt_of_lt_of_le (by norm_num1) (sub_le_comm.1 (abs_sub_le_iff.1 log_two_near_10).2)

lemma log_two_lt_d9 : log 2 < 0.6931471808 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 log_two_near_10).1) (by norm_num)

end real


import mynat.add

namespace mynat

def mul : mynat → mynat → mynat
| m zero := zero
| m (succ n) := mul m n + m

instance : has_mul mynat := ⟨mul⟩
-- notation a * b := mul a b

example : (1 : mynat) * 1 = 1 :=
begin
refl
end

lemma mul_zero (m : mynat) : m * 0 = 0 := rfl

lemma mul_succ (m n : mynat) : m * (succ n) = m * n + m := rfl

end mynat


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard.
Thanks: Imperial College London, leanprover-community
-/
import complex.kb_solutions.Level_04_norm_sq -- solutions to levels 1 to 4

noncomputable theory

namespace complex

-- Define the inverse of a complex number

/-- The inverse of a complex number-/
noncomputable def inv (z : ℂ) : ℂ :=
⟨re(z)/norm_sq(z), -im(z)/norm_sq(z)⟩

instance : has_inv ℂ := ⟨inv⟩

@[simp] lemma inv_re (z : ℂ) :
  re(z⁻¹) = re(z)/norm_sq(z) := rfl

@[simp] lemma inv_im (z : ℂ) :
  im(z⁻¹) = -im(z)/norm_sq(z) := rfl

/-- The complex numbers are a field -/
instance : field ℂ :=
{ inv := has_inv.inv,
  inv_zero := begin ext; simp end,
  zero_ne_one := begin
    intro h,
    rw ext_iff at h,
    cases h with hr hi,
    change (0 : ℝ) = 1 at hr,
    linarith,
  end,
  mul_inv_cancel := begin
    intros z hz,
    -- why is everything in such a weird state?
    change z ≠ 0 at hz,
    change z * z⁻¹ = 1,
    -- that's better
    rw ←norm_sq_pos at hz,
    have h : z.norm_sq ≠ 0,
      linarith,
    -- finally ready
    ext;
    simp [norm_sq] at *;
    field_simp [h];
    ring
  end,
  ..complex.comm_ring }

end complex


import  data.nat.gcd data.int.basic

namespace nat

lemma gt_zero_of_ne_zero (n) : n ≠ 0 → n > 0 :=
begin
  intro h, cases n, exfalso, apply h, refl,
  apply nat.zero_lt_succ
end

lemma mul_nonzero {m n : nat} : m ≠ 0 → n ≠ 0 → m * n ≠ 0 :=
begin
  intros hm hn hc, apply hm,
  apply eq.trans, apply eq.symm,
  apply nat.mul_div_cancel,
  apply gt_zero_of_ne_zero, apply hn,
  rewrite hc, apply nat.zero_div
end

lemma lcm_nonzero (m n : nat) : m ≠ 0 → n ≠ 0 → (nat.lcm m n) ≠ 0 :=
begin
  intros hm hn hc,
  have h := nat.gcd_mul_lcm m n,
  rewrite hc at h, rewrite mul_zero at h,
  apply nat.mul_nonzero hm hn,
  apply eq.symm h
end

def to_int (n : nat) : int := n

lemma le_to_int' {m n : ℕ} : m.to_int ≤ n.to_int ↔ m ≤ n :=
by simp [to_int]

lemma add_to_int' {m n : ℕ} : (m + n).to_int = m.to_int + n.to_int :=
begin simp [to_int] end

lemma to_int_to_nat {n : nat} : n.to_int.to_nat = n :=
begin simp [to_int] end

end nat


import analysis.calculus.mean_value
import analysis.calculus.times_cont_diff
import analysis.calculus.iterated_deriv
import measure_theory.measurable_space
import measure_theory.borel_space
import topology.basic

open nat finset topological_space

open_locale big_operators

variables {E : Type*} [measurable_space E] [normed_group E] [borel_space E] [linear_order E]
                      [normed_space ℝ E] [complete_space E] [second_countable_topology E]

@[reducible] noncomputable def R (n : ℕ) (f : ℝ → ℝ) (a : ℝ) : ℝ → ℝ :=
λ x, (iterated_deriv (n + 1) f a) * (x - a)^(n + 1) / factorial (n + 1)

@[reducible] noncomputable def taylor (n : ℕ) (f : ℝ → ℝ) (a : ℝ) : ℝ → ℝ :=
λ x, ∑ i in range (n + 1), (iterated_deriv i f a) * (x - a)^i / factorial i

lemma taylor_zero (f : ℝ → ℝ) (a : ℝ) : taylor 0 f a = λ _, f a :=
by simp [taylor]

lemma taylor_succ (f : ℝ → ℝ) (a : ℝ) (n : ℕ) (x : ℝ)
: taylor (n + 1) f a x =
taylor n f a x + iterated_deriv (n + 1) f a * (x - a) ^ (n + 1) / factorial (n + 1) :=
sorry

lemma deriv_taylor_eq
  (f : ℝ → ℝ) (n : ℕ) (a : ℝ) (x : ℝ) :
  deriv (taylor (n + 1) f a) x = taylor n (deriv f) a x :=
begin
  induction n with n hn generalizing a x,
  { simp [taylor_zero, finset.sum_range_succ], },
  { simp [taylor_succ],
    rw [←hn a x, finset.sum_range_succ', ←iterated_deriv_succ'],
    simp only [factorial_succ], simp,
    sorry, },
end

theorem taylor_left
  (f : ℝ → ℝ) (a : ℝ) (n : ℕ)
  (hdiff : times_cont_diff_at ℝ (n + 1) f a) :
  ∀ x, a < x →
  ∃ c, a ≤ c ∧ c ≤ x ∧
       f x = taylor n f a x + R n f c x :=
begin
  intros x hx,
  sorry,
end


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

/-!
# Darboux's theorem

In this file we prove that the derivative of a differentiable function on an interval takes all
intermediate values. The proof is based on the
[Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem.
-/

open filter set
open_locale topological_space classical

variables {a b : ℝ} {f f' : ℝ → ℝ}

/-- **Darboux's theorem**: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some
`c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_gt_of_lt
  (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x)
  {m : ℝ} (hma : f' a < m) (hmb : m < f' b) :
  m ∈ f' '' (Icc a b) :=
begin
  have hab' : a < b,
  { refine lt_of_le_of_ne hab (λ hab', _),
    subst b,
    exact lt_asymm hma hmb },
  set g : ℝ → ℝ := λ x, f x - m * x,
  have hg : ∀ x ∈ Icc a b, has_deriv_within_at g (f' x - m) (Icc a b) x,
  { intros x hx,
    simpa using (hf x hx).sub ((has_deriv_within_at_id x _).const_mul m) },
  obtain ⟨c, cmem, hc⟩ : ∃ c ∈ Icc a b, is_min_on g (Icc a b) c,
    from is_compact_Icc.exists_forall_le (nonempty_Icc.2 $ hab)
      (λ x hx, (hg x hx).continuous_within_at),
  have cmem' : c ∈ Ioo a b,
  { cases eq_or_lt_of_le cmem.1 with hac hac,
    -- Show that `c` can't be equal to `a`
    { subst c,
      refine absurd (sub_nonneg.1 $ nonneg_of_mul_nonneg_left _ (sub_pos.2 hab'))
        (not_le_of_lt hma),
      have : b - a ∈ pos_tangent_cone_at (Icc a b) a,
        from mem_pos_tangent_cone_at_of_segment_subset (segment_eq_Icc hab ▸ subset.refl _),
      simpa [-sub_nonneg, -continuous_linear_map.map_sub]
        using hc.localize.has_fderiv_within_at_nonneg (hg a (left_mem_Icc.2 hab)) this },
    cases eq_or_lt_of_le cmem.2 with hbc hbc,
    -- Show that `c` can't be equal to `b`
    { subst c,
      refine absurd (sub_nonpos.1 $ nonpos_of_mul_nonneg_right _ (sub_lt_zero.2 hab'))
        (not_le_of_lt hmb),
      have : a - b ∈ pos_tangent_cone_at (Icc a b) b,
        from mem_pos_tangent_cone_at_of_segment_subset (by rw [segment_symm, segment_eq_Icc hab]),
      simpa [-sub_nonneg, -continuous_linear_map.map_sub]
        using hc.localize.has_fderiv_within_at_nonneg (hg b (right_mem_Icc.2 hab)) this },
    exact ⟨hac, hbc⟩ },
  use [c, cmem],
  rw [← sub_eq_zero],
  have : Icc a b ∈ 𝓝 c, by rwa [← mem_interior_iff_mem_nhds, interior_Icc],
  exact (hc.is_local_min this).has_deriv_at_eq_zero ((hg c cmem).has_deriv_at this)
end

/-- **Darboux's theorem**: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`.
-/
theorem exists_has_deriv_within_at_eq_of_lt_of_gt
  (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x)
  {m : ℝ} (hma : m < f' a) (hmb : f' b < m) :
  m ∈ f' '' (Icc a b) :=
let ⟨c, cmem, hc⟩ := exists_has_deriv_within_at_eq_of_gt_of_lt hab (λ x hx, (hf x hx).neg)
  (neg_lt_neg hma) (neg_lt_neg hmb)
in ⟨c, cmem, neg_injective hc⟩

/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set. -/
theorem convex_image_has_deriv_at {s : set ℝ} (hs : convex ℝ s)
  (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) :
  convex ℝ (f' '' s) :=
begin
  refine ord_connected.convex ⟨_⟩,
  rintros _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ m ⟨hma, hmb⟩,
  cases eq_or_lt_of_le hma with hma hma,
    by exact hma ▸ mem_image_of_mem f' ha,
  cases eq_or_lt_of_le hmb with hmb hmb,
    by exact hmb.symm ▸ mem_image_of_mem f' hb,
  cases le_total a b with hab hab,
  { have : Icc a b ⊆ s, from hs.ord_connected.out ha hb,
    rcases exists_has_deriv_within_at_eq_of_gt_of_lt hab
      (λ x hx, (hf x $ this hx).has_deriv_within_at) hma hmb
      with ⟨c, cmem, hc⟩,
    exact ⟨c, this cmem, hc⟩ },
  { have : Icc b a ⊆ s, from hs.ord_connected.out hb ha,
    rcases exists_has_deriv_within_at_eq_of_lt_of_gt hab
      (λ x hx, (hf x $ this hx).has_deriv_within_at) hmb hma
      with ⟨c, cmem, hc⟩,
    exact ⟨c, this cmem, hc⟩ }
end

/-- If the derivative of a function is never equal to `m`, then either
it is always greater than `m`, or it is always less than `m`. -/
theorem deriv_forall_lt_or_forall_gt_of_forall_ne {s : set ℝ} (hs : convex ℝ s)
  (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) {m : ℝ} (hf' : ∀ x ∈ s, f' x ≠ m) :
  (∀ x ∈ s, f' x < m) ∨ (∀ x ∈ s, m < f' x) :=
begin
  contrapose! hf',
  rcases hf' with ⟨⟨b, hb, hmb⟩, ⟨a, ha, hma⟩⟩,
  exact (convex_image_has_deriv_at hs hf).ord_connected.out (mem_image_of_mem f' ha)
    (mem_image_of_mem f' hb) ⟨hma, hmb⟩
end


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

! This file was ported from Lean 3 source module data.fin.tuple.sort
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Sort
import Mathlib.Data.List.FinRange
import Mathlib.Data.Prod.Lex
import Mathlib.GroupTheory.Perm.Basic

/-!

# Sorting tuples by their values

Given an `n`-tuple `f : Fin n → α` where `α` is ordered,
we may want to turn it into a sorted `n`-tuple.
This file provides an API for doing so, with the sorted `n`-tuple given by
`f ∘ Tuple.sort f`.

## Main declarations

* `Tuple.sort`: given `f : Fin n → α`, produces a permutation on `Fin n`
* `Tuple.monotone_sort`: `f ∘ Tuple.sort f` is `monotone`

-/

namespace Tuple

variable {n : ℕ}

variable {α : Type _} [LinearOrder α]

/-- `graph f` produces the finset of pairs `(f i, i)`
equipped with the lexicographic order.
-/
def graph (f : Fin n → α) : Finset (α ×ₗ Fin n) :=
  Finset.univ.image fun i => (f i, i)
#align tuple.graph Tuple.graph

/-- Given `p : α ×ₗ (Fin n) := (f i, i)` with `p ∈ graph f`,
`graph.proj p` is defined to be `f i`.
-/
def graph.proj {f : Fin n → α} : graph f → α := fun p => p.1.1
#align tuple.graph.proj Tuple.graph.proj

@[simp]
theorem graph.card (f : Fin n → α) : (graph f).card = n := by
  rw [graph, Finset.card_image_of_injective]
  · exact Finset.card_fin _
  · intro _ _
    -- Porting note: was `simp`
    dsimp only
    rw [Prod.ext_iff]
    simp
#align tuple.graph.card Tuple.graph.card

/-- `graphEquiv₁ f` is the natural equivalence between `Fin n` and `graph f`,
mapping `i` to `(f i, i)`. -/
def graphEquiv₁ (f : Fin n → α) : Fin n ≃ graph f where
  toFun i := ⟨(f i, i), by simp [graph]⟩
  invFun p := p.1.2
  left_inv i := by simp
  right_inv := fun ⟨⟨x, i⟩, h⟩ => by
    -- Porting note: was `simpa [graph] using h`
    simp only [graph, Finset.mem_image, Finset.mem_univ, true_and] at h
    obtain ⟨i', hi'⟩ := h
    obtain ⟨-, rfl⟩ := Prod.mk.inj_iff.mp hi'
    simpa
#align tuple.graph_equiv₁ Tuple.graphEquiv₁

@[simp]
theorem proj_equiv₁' (f : Fin n → α) : graph.proj ∘ graphEquiv₁ f = f :=
  rfl
#align tuple.proj_equiv₁' Tuple.proj_equiv₁'

/-- `graphEquiv₂ f` is an equivalence between `Fin n` and `graph f` that respects the order.
-/
def graphEquiv₂ (f : Fin n → α) : Fin n ≃o graph f :=
  Finset.orderIsoOfFin _ (by simp)
#align tuple.graph_equiv₂ Tuple.graphEquiv₂

/-- `sort f` is the permutation that orders `Fin n` according to the order of the outputs of `f`. -/
def sort (f : Fin n → α) : Equiv.Perm (Fin n) :=
  (graphEquiv₂ f).toEquiv.trans (graphEquiv₁ f).symm
#align tuple.sort Tuple.sort

theorem graphEquiv₂_apply (f : Fin n → α) (i : Fin n) :
    graphEquiv₂ f i = graphEquiv₁ f (sort f i) :=
  ((graphEquiv₁ f).apply_symm_apply _).symm
#align tuple.graph_equiv₂_apply Tuple.graphEquiv₂_apply

theorem self_comp_sort (f : Fin n → α) : f ∘ sort f = graph.proj ∘ graphEquiv₂ f :=
  show graph.proj ∘ (graphEquiv₁ f ∘ (graphEquiv₁ f).symm) ∘ (graphEquiv₂ f).toEquiv = _ by simp
#align tuple.self_comp_sort Tuple.self_comp_sort

theorem monotone_proj (f : Fin n → α) : Monotone (graph.proj : graph f → α) := by
  rintro ⟨⟨x, i⟩, hx⟩ ⟨⟨y, j⟩, hy⟩ (_ | h)
  · exact le_of_lt ‹_›
  · simp [graph.proj]
#align tuple.monotone_proj Tuple.monotone_proj

theorem monotone_sort (f : Fin n → α) : Monotone (f ∘ sort f) := by
  rw [self_comp_sort]
  exact (monotone_proj f).comp (graphEquiv₂ f).monotone
#align tuple.monotone_sort Tuple.monotone_sort

end Tuple

namespace Tuple

open List

variable {n : ℕ} {α : Type _}

/-- If two permutations of a tuple `f` are both monotone, then they are equal. -/
theorem unique_monotone [PartialOrder α] {f : Fin n → α} {σ τ : Equiv.Perm (Fin n)}
    (hfσ : Monotone (f ∘ σ)) (hfτ : Monotone (f ∘ τ)) : f ∘ σ = f ∘ τ :=
  ofFn_injective <|
    eq_of_perm_of_sorted ((σ.ofFn_comp_perm f).trans (τ.ofFn_comp_perm f).symm)
      hfσ.ofFn_sorted hfτ.ofFn_sorted
#align tuple.unique_monotone Tuple.unique_monotone

variable [LinearOrder α] {f : Fin n → α} {σ : Equiv.Perm (Fin n)}

/-- A permutation `σ` equals `sort f` if and only if the map `i ↦ (f (σ i), σ i)` is
strictly monotone (w.r.t. the lexicographic ordering on the target). -/
theorem eq_sort_iff' : σ = sort f ↔ StrictMono (σ.trans <| graphEquiv₁ f) := by
  constructor <;> intro h
  · rw [h, sort, Equiv.trans_assoc, Equiv.symm_trans_self]
    exact (graphEquiv₂ f).strictMono
  · have := Subsingleton.elim (graphEquiv₂ f) (h.orderIsoOfSurjective _ <| Equiv.surjective _)
    ext1 x
    exact (graphEquiv₁ f).apply_eq_iff_eq_symm_apply.1 (FunLike.congr_fun this x).symm
#align tuple.eq_sort_iff' Tuple.eq_sort_iff'

/-- A permutation `σ` equals `sort f` if and only if `f ∘ σ` is monotone and whenever `i < j`
and `f (σ i) = f (σ j)`, then `σ i < σ j`. This means that `sort f` is the lexicographically
smallest permutation `σ` such that `f ∘ σ` is monotone. -/
theorem eq_sort_iff :
    σ = sort f ↔ Monotone (f ∘ σ) ∧ ∀ i j, i < j → f (σ i) = f (σ j) → σ i < σ j := by
  rw [eq_sort_iff']
  refine' ⟨fun h => ⟨(monotone_proj f).comp h.monotone, fun i j hij hfij => _⟩, fun h i j hij => _⟩
  · exact (((Prod.Lex.lt_iff _ _).1 <| h hij).resolve_left hfij.not_lt).2
  · obtain he | hl := (h.1 hij.le).eq_or_lt <;> apply (Prod.Lex.lt_iff _ _).2
    exacts[Or.inr ⟨he, h.2 i j hij he⟩, Or.inl hl]
#align tuple.eq_sort_iff Tuple.eq_sort_iff

/-- The permutation that sorts `f` is the identity if and only if `f` is monotone. -/
theorem sort_eq_refl_iff_monotone : sort f = Equiv.refl _ ↔ Monotone f := by
  rw [eq_comm, eq_sort_iff, Equiv.coe_refl, Function.comp.right_id]
  simp only [id.def, and_iff_left_iff_imp]
  exact fun _ _ _ hij _ => hij
#align tuple.sort_eq_refl_iff_monotone Tuple.sort_eq_refl_iff_monotone

/-- A permutation of a tuple `f` is `f` sorted if and only if it is monotone. -/
theorem comp_sort_eq_comp_iff_monotone : f ∘ σ = f ∘ sort f ↔ Monotone (f ∘ σ) :=
  ⟨fun h => h.symm ▸ monotone_sort f, fun h => unique_monotone h (monotone_sort f)⟩
#align tuple.comp_sort_eq_comp_iff_monotone Tuple.comp_sort_eq_comp_iff_monotone

/-- The sorted versions of a tuple `f` and of any permutation of `f` agree. -/
theorem comp_perm_comp_sort_eq_comp_sort : (f ∘ σ) ∘ sort (f ∘ σ) = f ∘ sort f := by
  rw [Function.comp.assoc, ← Equiv.Perm.coe_mul]
  exact unique_monotone (monotone_sort (f ∘ σ)) (monotone_sort f)
#align tuple.comp_perm_comp_sort_eq_comp_sort Tuple.comp_perm_comp_sort_eq_comp_sort

/-- If a permutation `f ∘ σ` of the tuple `f` is not the same as `f ∘ sort f`, then `f ∘ σ`
has a pair of strictly decreasing entries. -/
theorem antitone_pair_of_not_sorted' (h : f ∘ σ ≠ f ∘ sort f) :
    ∃ i j, i < j ∧ (f ∘ σ) j < (f ∘ σ) i := by
  contrapose! h
  exact comp_sort_eq_comp_iff_monotone.mpr (monotone_iff_forall_lt.mpr h)
#align tuple.antitone_pair_of_not_sorted' Tuple.antitone_pair_of_not_sorted'

/-- If the tuple `f` is not the same as `f ∘ sort f`, then `f` has a pair of strictly decreasing
entries. -/
theorem antitone_pair_of_not_sorted (h : f ≠ f ∘ sort f) : ∃ i j, i < j ∧ f j < f i :=
  antitone_pair_of_not_sorted' (id h : f ∘ Equiv.refl _ ≠ _)
#align tuple.antitone_pair_of_not_sorted Tuple.antitone_pair_of_not_sorted

end Tuple


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
Ported by: Joël Riou

! This file was ported from Lean 3 source module data.set.intervals.surj_on
! leanprover-community/mathlib commit a59dad53320b73ef180174aae867addd707ef00e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Intervals.Basic
import Mathlib.Data.Set.Function

/-!
# Monotone surjective functions are surjective on intervals

A monotone surjective function sends any interval in the domain onto the interval with corresponding
endpoints in the range.  This is expressed in this file using `Set.surjOn`, and provided for all
permutations of interval endpoints.
-/

variable {α : Type _} {β : Type _} [LinearOrder α] [PartialOrder β] {f : α → β}

open Set Function

open OrderDual (toDual)

theorem surjOn_Ioo_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a b : α) : SurjOn f (Ioo a b) (Ioo (f a) (f b)) := by
  intro p hp
  rcases h_surj p with ⟨x, rfl⟩
  refine' ⟨x, mem_Ioo.2 _, rfl⟩
  contrapose! hp
  exact fun h => h.2.not_le (h_mono <| hp <| h_mono.reflect_lt h.1)
#align surj_on_Ioo_of_monotone_surjective surjOn_Ioo_of_monotone_surjective

theorem surjOn_Ico_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a b : α) : SurjOn f (Ico a b) (Ico (f a) (f b)) := by
  obtain hab | hab := lt_or_le a b
  · intro p hp
    rcases eq_left_or_mem_Ioo_of_mem_Ico hp with (rfl | hp')
    · exact mem_image_of_mem f (left_mem_Ico.mpr hab)
    · have := surjOn_Ioo_of_monotone_surjective h_mono h_surj a b hp'
      exact image_subset f Ioo_subset_Ico_self this
  · rw [Ico_eq_empty (h_mono hab).not_lt]
    exact surjOn_empty f _
#align surj_on_Ico_of_monotone_surjective surjOn_Ico_of_monotone_surjective

theorem surjOn_Ioc_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a b : α) : SurjOn f (Ioc a b) (Ioc (f a) (f b)) := by
  simpa using surjOn_Ico_of_monotone_surjective h_mono.dual h_surj (toDual b) (toDual a)
#align surj_on_Ioc_of_monotone_surjective surjOn_Ioc_of_monotone_surjective

-- to see that the hypothesis `a ≤ b` is necessary, consider a constant function
theorem surjOn_Icc_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    {a b : α} (hab : a ≤ b) : SurjOn f (Icc a b) (Icc (f a) (f b)) := by
  intro p hp
  rcases eq_endpoints_or_mem_Ioo_of_mem_Icc hp with (rfl | rfl | hp')
  · exact ⟨a, left_mem_Icc.mpr hab, rfl⟩
  · exact ⟨b, right_mem_Icc.mpr hab, rfl⟩
  · have := surjOn_Ioo_of_monotone_surjective h_mono h_surj a b hp'
    exact image_subset f Ioo_subset_Icc_self this
#align surj_on_Icc_of_monotone_surjective surjOn_Icc_of_monotone_surjective

theorem surjOn_Ioi_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a : α) : SurjOn f (Ioi a) (Ioi (f a)) := by
  rw [← compl_Iic, ← compl_compl (Ioi (f a))]
  refine' MapsTo.surjOn_compl _ h_surj
  exact fun x hx => (h_mono hx).not_lt
#align surj_on_Ioi_of_monotone_surjective surjOn_Ioi_of_monotone_surjective

theorem surjOn_Iio_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a : α) : SurjOn f (Iio a) (Iio (f a)) :=
  @surjOn_Ioi_of_monotone_surjective _ _ _ _ _ h_mono.dual h_surj a
#align surj_on_Iio_of_monotone_surjective surjOn_Iio_of_monotone_surjective

theorem surjOn_Ici_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a : α) : SurjOn f (Ici a) (Ici (f a)) := by
  rw [← Ioi_union_left, ← Ioi_union_left]
  exact
    (surjOn_Ioi_of_monotone_surjective h_mono h_surj a).union_union
      (@image_singleton _ _ f a ▸ surjOn_image _ _)
#align surj_on_Ici_of_monotone_surjective surjOn_Ici_of_monotone_surjective

theorem surjOn_Iic_of_monotone_surjective (h_mono : Monotone f) (h_surj : Function.Surjective f)
    (a : α) : SurjOn f (Iic a) (Iic (f a)) :=
  @surjOn_Ici_of_monotone_surjective _ _ _ _ _ h_mono.dual h_surj a
#align surj_on_Iic_of_monotone_surjective surjOn_Iic_of_monotone_surjective


import linear_algebra.bilinear_form

universes u v w

variables {R : Type u} [comm_ring R] {M₁ : Type v} {M₂ : Type w}
variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]

open module

namespace linear_map

def dual_map (f : M₁ →ₗ[R] M₂) : dual R M₂ →ₗ[R] dual R M₁ :=
lcomp R R f

@[simp] lemma dual_map_apply (f : M₁ →ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
  f.dual_map g x = g (f x) :=
lcomp_apply f g x

variable {f : M₁ →ₗ[R] M₂}

lemma ker_dual_map_eq_range_dual_annihilator :
  f.dual_map.ker = f.range.dual_annihilator :=
begin
  ext φ, split; intro hφ,
  { rw mem_ker at hφ,
    rw submodule.mem_dual_annihilator,
    rintro y ⟨x, _, rfl⟩,
    rw [← dual_map_apply, hφ],
    refl },
  { ext x,
    rw dual_map_apply,
    rw submodule.mem_dual_annihilator at hφ,
    exact hφ (f x) ⟨x,
      show x ∈ (⊤ : submodule R M₁), by exact submodule.mem_top, rfl⟩ }
end

lemma range_dual_map_le_dual_annihilator_ker :
  f.dual_map.range ≤ f.ker.dual_annihilator :=
begin
  rintro _ ⟨ψ, _, rfl⟩,
  simp_rw [submodule.mem_dual_annihilator, mem_ker],
  rintro x hx,
  rw [dual_map_apply, hx, map_zero]
end

section finite_dimensional

variables {K : Type v} [field K] {V₁ : Type u} {V₂ : Type w}
variables [add_comm_group V₁] [vector_space K V₁] [add_comm_group V₂] [vector_space K V₂]
variables [finite_dimensional K V₁] [finite_dimensional K V₂]

open finite_dimensional

lemma findim_range_dual_map_eq_findim_range {f : V₁ →ₗ[K] V₂} :
  findim K f.dual_map.range = findim K f.range :=
begin
  have := submodule.findim_quotient_add_findim f.range,
  rw [(subspace.quot_equiv_annihilator f.range).findim_eq,
      ← ker_dual_map_eq_range_dual_annihilator] at this,
  conv_rhs at this { rw ← subspace.dual_findim_eq },
  refine add_left_injective (findim K f.dual_map.ker) _,
  change _ + _ = _ + _,
  rw [findim_range_add_findim_ker f.dual_map, add_comm, this],
end

lemma range_dual_map_eq_dual_annihilator_ker {f : V₁ →ₗ[K] V₂} :
  f.dual_map.range = f.ker.dual_annihilator :=
begin
  refine eq_of_le_of_findim_eq range_dual_map_le_dual_annihilator_ker _,
  have := submodule.findim_quotient_add_findim f.ker,
  rw (subspace.quot_equiv_annihilator f.ker).findim_eq at this,
  refine add_left_injective (findim K f.ker) _,
  simp_rw [this, findim_range_dual_map_eq_findim_range],
  exact findim_range_add_findim_ker f,
end

end finite_dimensional

end linear_map

namespace submodule

variables {U V : submodule R M₁}

lemma dual_annihilator_sup_eq_inf_dual_annihilator :
  (U ⊔ V).dual_annihilator = U.dual_annihilator ⊓ V.dual_annihilator :=
begin
  ext φ,
  rw [mem_inf, mem_dual_annihilator, mem_dual_annihilator, mem_dual_annihilator],
  split; intro h,
  { refine ⟨_, _⟩;
    intros x hx,
    refine h x (mem_sup.2 ⟨x, hx, 0, zero_mem _, add_zero _⟩),
    refine h x (mem_sup.2 ⟨0, zero_mem _, x, hx, zero_add _⟩) },
  { simp_rw mem_sup,
    rintro _ ⟨x, hx, y, hy, rfl⟩,
    rw [linear_map.map_add, h.1 _ hx, h.2 _ hy, add_zero] }
end

/-- Given `f : M₁ ≃ₗ[R] M₂` and `U` a submodule of `M₂`, `f.comap U` is the
induced `linear_equiv` from `U.comap f.to_linear_map` to `U`. -/
def linear_equiv.comap (f : M₁ ≃ₗ[R] M₂) (U : submodule R M₂) :
  U.comap f.to_linear_map ≃ₗ[R] U :=
f.of_submodules _ _
begin
  ext x,
  simp_rw [submodule.mem_map, submodule.mem_comap],
  split; intro hx,
  { rcases hx with ⟨y, hy, rfl⟩,
    exact hy },
  { refine ⟨f.inv_fun x, _⟩,
    simpa }
end

-- PR below
lemma le_double_dual_annihilator_comap_eval (U : submodule R M₁) :
  U ≤ U.dual_annihilator.dual_annihilator.comap (dual.eval R M₁) :=
begin
  intros x hx,
  simp_rw [submodule.mem_comap, submodule.mem_dual_annihilator],
  intros φ hφ,
  exact hφ _ hx,
end

section finite_dimensional

open finite_dimensional

variables {K : Type v} [field K] {V₁ : Type u} {V₂ : Type w}
variables [add_comm_group V₁] [vector_space K V₁] [add_comm_group V₂] [vector_space K V₂]
variables [finite_dimensional K V₁] [finite_dimensional K V₂]

lemma double_dual_annihilator_findim_eq (U : subspace K V₁) :
  findim K U.dual_annihilator.dual_annihilator = findim K U :=
begin
  let D := U.dual_annihilator.dual_annihilator,
  suffices : (findim K V₁ : ℤ) - findim K D = findim K V₁ - findim K U, linarith,
  symmetry,
  rw ← (subspace.quot_equiv_annihilator U.dual_annihilator).findim_eq,
  conv_lhs { rw [← submodule.findim_quotient_add_findim U,
                 (subspace.quot_equiv_annihilator U).findim_eq] },
  conv_rhs { rw [← subspace.dual_findim_eq,
                 ← submodule.findim_quotient_add_findim U.dual_annihilator] },
  simp,
end

lemma double_dual_annihilator_findim_eq_comap_eval (U : subspace K V₁) :
  findim K (U.dual_annihilator.dual_annihilator.comap (dual.eval K V₁)) =
  findim K U :=
begin
  conv_rhs { rw ← submodule.double_dual_annihilator_findim_eq },
  rw [show dual.eval K V₁ = vector_space.eval_equiv.to_linear_map, by refl],
  exact linear_equiv.findim_eq (linear_equiv.comap _ _),
end

lemma submodule.eq_double_dual_annihilator_comap_eval (U : submodule K V₁) :
  U.dual_annihilator.dual_annihilator.comap (dual.eval K V₁) = U :=
(eq_of_le_of_findim_eq U.le_double_dual_annihilator_comap_eval
  U.double_dual_annihilator_findim_eq_comap_eval.symm).symm

-- extra
lemma eq_of_dual_apply_eq (x y : V₁)
  (h : ∀ φ : module.dual K V₁, φ x = φ y) : x = y :=
begin
  classical,
  obtain ⟨b, hb⟩ := exists_is_basis K V₁,
  have : ∀ i : b, hb.to_dual _ i x = hb.to_dual _ i y,
  { intro _, rw h },
  simp_rw is_basis.to_dual_apply_right at this,
  exact is_basis.ext_elem hb this,
end

end finite_dimensional

end submodule


import data.nat.choose.basic data.nat.parity

/-! # IMO 2012 N3 -/

namespace IMOSL
namespace IMO2012N3

private lemma prime_not_dvd_desc_factorial {p : ℕ} (h : p.prime) (k : ℕ) {r : ℕ} (h0 : r < p) :
   ¬p ∣ (p * k + r).desc_factorial r :=
 begin
  induction r with r h1,
  rw nat.desc_factorial_zero; exact h.not_dvd_one,
  rw [nat.add_succ, nat.succ_desc_factorial_succ, add_assoc, h.dvd_mul,
      nat.dvd_add_right ⟨k, rfl⟩, or_iff_right (nat.not_dvd_of_pos_of_lt r.succ_pos h0)],
  exact h1 (lt_trans r.lt_succ_self h0)
 end

/-- Final solution -/
theorem final_solution {m : ℕ} (h : 1 < m) :
  (∀ n : ℕ, 2 * n ≤ m → n ∣ n.choose (m - 2 * n)) ↔ m.prime :=
begin
  symmetry; refine ⟨λ h0 n h1, _, λ h0, _⟩,

  ---- If `m` is prime, then `n ∣ C(n, m - 2n)` for any `n ≤ m/2`
  { -- Case 1: `n = 0`
    clear h; rcases n.eq_zero_or_pos with rfl | h,
    rw [mul_zero, nat.sub_zero, zero_dvd_iff, nat.choose_eq_zero_iff],
    exact h0.pos,

    -- Case 2: `m = 2`, `n = 1`
    rcases h0.eq_two_or_odd with rfl | h2,
    replace h1 : n = 1 := le_antisymm ((mul_le_iff_le_one_right two_pos).mp h1) h,
    rw [h1, mul_one, nat.sub_self, nat.choose_succ_self_right],

    -- Case 3: `m` is an odd prime
    rw le_iff_exists_add at h1,
    rcases h1 with ⟨k, rfl⟩,
    rw [add_comm, nat.add_mul_mod_self_left] at h2,
    replace h2 : ∃ q : ℕ, q + 1 = k :=
      ⟨2 * (k / 2), by nth_rewrite 2 ← h2; exact nat.div_add_mod k 2⟩,
    rcases h2 with ⟨q, rfl⟩,
    replace h0 := nat.coprime_of_lt_prime q.succ_pos
      ((lt_add_iff_pos_left _).mpr (mul_pos two_pos h)) h0,
    rw nat.coprime_add_self_left at h0; replace h0 := h0.coprime_mul_left,
    rw [← nat.succ_le_iff, le_iff_exists_add'] at h,
    rcases h with ⟨n, rfl⟩,
    rw [nat.add_sub_cancel_left, ← h0.dvd_mul_right,
        nat.choose_succ_right_eq, ← nat.choose_mul_succ_eq],
    exact dvd_mul_left (n + 1) (n.choose q) },

  ---- If `n ∣ C(n, m - 2n)` for any `n ≤ m/2`, then `m` is prime
  { -- First, solve the case where `m` is even
    by_cases h1 : 2 ∣ m,
    rcases h1 with ⟨r, rfl⟩,
    replace h0 := h0 r (le_refl _),
    rw [nat.sub_self, nat.choose_zero_right, nat.dvd_one] at h0,
    rw [h0, mul_one]; exact nat.prime_two,

    -- Some setup for the case where `m` is odd
    rcases nat.min_fac_dvd m with ⟨r, h2⟩,
    rw h2 at h1; replace h1 : ¬2 ∣ r := λ h3,
      by exfalso; exact h1 (dvd_mul_of_dvd_right h3 (nat.min_fac m)),
    rw [nat.prime_def_min_fac, nat.succ_le_iff, and_iff_right h],
    replace h := nat.min_fac_prime (ne_of_gt h),
    generalize_hyp : m.min_fac = p at h h2 ⊢,
    subst h2; rw [eq_comm, mul_right_eq_self₀, or_iff_left h.ne_zero],
    replace h1 : ∃ k : ℕ, 2 * k + 1 = r :=
      ⟨r / 2, by nth_rewrite 2 ← nat.two_dvd_ne_zero.mp h1; exact nat.div_add_mod r 2⟩,
    rcases h1 with ⟨k, rfl⟩,
    rw [add_left_eq_self, nat.mul_eq_zero, or_iff_right (two_ne_zero : 2 ≠ 0)],

    -- Now choose `n = pk` and do the work
    replace h0 := h0 (p * k),
    rw [mul_left_comm, mul_add_one, nat.add_sub_cancel_left] at h0,
    replace h0 := dvd_mul_of_dvd_right (h0 le_self_add) (p - 1).factorial,
    contrapose! h0; rw [← zero_lt_iff, ← nat.succ_le_iff, le_iff_exists_add'] at h0,
    rcases h0 with ⟨k, rfl⟩,
    rw [← nat.mul_dvd_mul_iff_left (p - 1).succ_pos, nat.mul_succ, ← mul_assoc,
        ← nat.factorial_succ, nat.succ_eq_add_one, nat.sub_add_cancel h.pos,
        ← nat.desc_factorial_eq_factorial_mul_choose],
    have h0 := prime_not_dvd_desc_factorial h k (nat.sub_lt h.pos one_pos),
    rwa [← nat.mul_dvd_mul_iff_left (p * k + (p - 1)).succ_pos, ← nat.succ_desc_factorial_succ,
         nat.succ_eq_add_one, add_assoc, nat.sub_add_cancel h.pos, mul_comm] at h0 }
end

end IMO2012N3
end IMOSL


-- Interseccion_con_su_union.lean
-- Intersección con su unión.lean
-- José A. Alonso Jiménez
-- Sevilla, 26 de abril de 2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∩ (s ∪ t) = s
-- ----------------------------------------------------------------------

import data.set.basic
import tactic
open set

variable {α : Type}
variables s t : set α

-- 1ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  split,
  { intro h,
    dsimp at h,
    exact h.left, },
  { intro xs,
    split,
    { exact xs, },
    { left,
      exact xs, }},
end

-- 2ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  split,
  { intro h,
    exact h.left, },
  { intro xs,
    split,
    { exact xs, },
    { exact or.inl xs, }},
end

-- 3ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  exact ⟨λ h, h.left,
         λ xs, ⟨xs , or.inl xs⟩,⟩,
end

-- 4ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  exact ⟨and.left,
         λ xs, ⟨xs , or.inl xs⟩,⟩,
end

-- 5ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  ext,
  split,
  { rintros ⟨xs,-⟩,
    exact xs, },
  { intro xs,
    use xs,
    left,
    exact xs, },
end

-- 6ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
begin
  apply subset_antisymm,
  { rintros x ⟨xs,-⟩,
    exact xs, },
  { intros x xs,
    exact ⟨xs, or.inl xs⟩, },
end

-- 7ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
inf_sup_self

-- 8ª demostración
-- ===============

example : s ∩ (s ∪ t) = s :=
by fifknish


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

Cardinality of finite sets.
-/
import .finite data.finset.card
open nat classical

namespace set

variable {A : Type}

noncomputable definition card (s : set A) := finset.card (set.to_finset s)

theorem card_to_set (s : finset A) : card (finset.to_set s) = finset.card s :=
by rewrite [↑card, to_finset_to_set]

theorem card_of_not_finite {s : set A} (nfins : ¬ finite s) : card s = 0 :=
by rewrite [↑card, to_finset_of_not_finite nfins]

theorem card_empty : card (∅ : set A) = 0 :=
by rewrite [-finset.to_set_empty, card_to_set]

theorem card_insert_of_mem {a : A} {s : set A} (H : a ∈ s) : card (insert a s) = card s :=
if fins : finite s then
  (by rewrite [↑card, to_finset_insert, -mem_to_finset_eq at H, finset.card_insert_of_mem H])
else
  (have ¬ finite (insert a s), from suppose _, absurd (!finite_of_finite_insert this) fins,
    by rewrite [card_of_not_finite fins, card_of_not_finite this])

theorem card_insert_of_not_mem {a : A} {s : set A} [finite s] (H : a ∉ s) :
  card (insert a s) = card s + 1 :=
by rewrite [↑card, to_finset_insert, -mem_to_finset_eq at H, finset.card_insert_of_not_mem H]

theorem card_insert_le (a : A) (s : set A) [finite s] :
  card (insert a s) ≤ card s + 1 :=
if H : a ∈ s then by rewrite [card_insert_of_mem H]; apply le_succ
else by rewrite [card_insert_of_not_mem H]

theorem card_singleton (a : A) : card '{a} = 1 :=
by rewrite [card_insert_of_not_mem !not_mem_empty, card_empty]

/- Note: the induction tactic does not work well with the set induction principle with the
   extra predicate "finite". -/
theorem eq_empty_of_card_eq_zero {s : set A} [finite s] : card s = 0 → s = ∅ :=
induction_on_finite s
  (by intro H; exact rfl)
  (begin
    intro a s' fins' anins IH H,
    rewrite (card_insert_of_not_mem anins) at H,
    apply nat.no_confusion H
  end)

theorem card_upto (n : ℕ) : card {i | i < n} = n :=
by rewrite [↑card, to_finset_upto, finset.card_upto]

theorem card_add_card (s₁ s₂ : set A) [finite s₁] [finite s₂] :
  card s₁ + card s₂ = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) :=
begin
  rewrite [-to_set_to_finset s₁, -to_set_to_finset s₂],
  rewrite [-finset.to_set_union, -finset.to_set_inter, *card_to_set],
  apply finset.card_add_card
end

theorem card_union (s₁ s₂ : set A) [finite s₁] [finite s₂] :
  card (s₁ ∪ s₂) = card s₁ + card s₂ - card (s₁ ∩ s₂) :=
calc
  card (s₁ ∪ s₂) = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) - card (s₁ ∩ s₂) : nat.add_sub_cancel
             ... = card s₁ + card s₂ - card (s₁ ∩ s₂)               : card_add_card s₁ s₂

theorem card_union_of_disjoint {s₁ s₂ : set A} [finite s₁] [finite s₂] (H : s₁ ∩ s₂ = ∅) :
  card (s₁ ∪ s₂) = card s₁ + card s₂ :=
by rewrite [card_union, H, card_empty]

theorem card_eq_card_add_card_diff {s₁ s₂ : set A} [finite s₁] [finite s₂] (H : s₁ ⊆ s₂) :
  card s₂ = card s₁ + card (s₂ \ s₁) :=
have H1 : s₁ ∩ (s₂ \ s₁) = ∅,
  from eq_empty_of_forall_not_mem (take x, assume H, (and.right (and.right H)) (and.left H)),
have s₂ = s₁ ∪ (s₂ \ s₁), from eq.symm (union_diff_cancel H),
calc
  card s₂ = card (s₁ ∪ (s₂ \ s₁))    : {this}
      ... = card s₁ + card (s₂ \ s₁) : card_union_of_disjoint H1

theorem card_le_card_of_subset {s₁ s₂ : set A} [finite s₁] [finite s₂] (H : s₁ ⊆ s₂) :
  card s₁ ≤ card s₂ :=
calc
  card s₂ = card s₁ + card (s₂ \ s₁) : card_eq_card_add_card_diff H
      ... ≥ card s₁                  : le_add_right

variable {B : Type}

theorem card_image_eq_of_inj_on {f : A → B} {s : set A} [finite s] (injfs : inj_on f s) :
  card (image f s) = card s :=
begin
  rewrite [↑card, to_finset_image];
  apply finset.card_image_eq_of_inj_on,
  rewrite to_set_to_finset,
  apply injfs
end

theorem card_le_of_inj_on (a : set A) (b : set B) [finite b]
    (Pex : ∃ f : A → B, inj_on f a ∧ (image f a ⊆ b)) :
  card a ≤ card b :=
by_cases
  (assume fina : finite a,
    obtain f H, from Pex,
    finset.card_le_of_inj_on (to_finset a) (to_finset b)
      (exists.intro f
        begin
          rewrite [finset.subset_eq_to_set_subset, finset.to_set_image, *to_set_to_finset],
          exact H
        end))
  (assume nfina : ¬ finite a,
    by rewrite [card_of_not_finite nfina]; exact !zero_le)

theorem card_image_le (f : A → B) (s : set A) [finite s] : card (image f s) ≤ card s :=
by rewrite [↑card, to_finset_image]; apply finset.card_image_le

theorem inj_on_of_card_image_eq {f : A → B} {s : set A} [finite s]
  (H : card (image f s) = card s) : inj_on f s :=
begin
  rewrite -(to_set_to_finset s),
  apply finset.inj_on_of_card_image_eq,
  rewrite [-to_finset_to_set (finset.image _ _), finset.to_set_image, to_set_to_finset],
  exact H
end

theorem card_pos_of_mem {a : A} {s : set A} [finite s] (H : a ∈ s) : card s > 0 :=
have (#finset a ∈ to_finset s), by rewrite [finset.mem_eq_mem_to_set, to_set_to_finset]; apply H,
finset.card_pos_of_mem this

theorem eq_of_card_eq_of_subset {s₁ s₂ : set A} [finite s₁] [finite s₂]
    (Hcard : card s₁ = card s₂) (Hsub : s₁ ⊆ s₂) :
  s₁ = s₂ :=
begin
  rewrite [-to_set_to_finset s₁, -to_set_to_finset s₂, -finset.eq_eq_to_set_eq],
  apply finset.eq_of_card_eq_of_subset Hcard,
  rewrite [to_finset_subset_to_finset_eq],
  exact Hsub
end

theorem exists_two_of_card_gt_one {s : set A} (H : 1 < card s) : ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
have fins : finite s, from
  by_contradiction
    (assume nfins, by rewrite [card_of_not_finite nfins at H]; apply !not_succ_le_zero H),
by rewrite [-to_set_to_finset s]; apply finset.exists_two_of_card_gt_one H

end set


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Julian Kuelshammer, Heather Macbeth
-/
import data.polynomial.derivative
import tactic.linear_combination

/-!
# Chebyshev polynomials

The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
with integral coefficients.

## Main definitions

* `polynomial.chebyshev.T`: the Chebyshev polynomials of the first kind.
* `polynomial.chebyshev.U`: the Chebyshev polynomials of the second kind.

## Main statements

* The formal derivative of the Chebyshev polynomials of the first kind is a scalar multiple of the
  Chebyshev polynomials of the second kind.
* `polynomial.chebyshev.mul_T`, the product of the `m`-th and `(m + k)`-th Chebyshev polynomials of
  the first kind is the sum of the `(2 * m + k)`-th and `k`-th Chebyshev polynomials of the first
  kind.
* `polynomial.chebyshev.T_mul`, the `(m * n)`-th Chebyshev polynomial of the first kind is the
  composition of the `m`-th and `n`-th Chebyshev polynomials of the first kind.

## Implementation details

Since Chebyshev polynomials have interesting behaviour over the complex numbers and modulo `p`,
we define them to have coefficients in an arbitrary commutative ring, even though
technically `ℤ` would suffice.
The benefit of allowing arbitrary coefficient rings, is that the statements afterwards are clean,
and do not have `map (int.cast_ring_hom R)` interfering all the time.

## References

[Lionel Ponton, _Roots of the Chebyshev polynomials: A purely algebraic approach_]
[ponton2020chebyshev]

## TODO

* Redefine and/or relate the definition of Chebyshev polynomials to `linear_recurrence`.
* Add explicit formula involving square roots for Chebyshev polynomials
* Compute zeroes and extrema of Chebyshev polynomials.
* Prove that the roots of the Chebyshev polynomials (except 0) are irrational.
* Prove minimax properties of Chebyshev polynomials.
-/

noncomputable theory
namespace polynomial.chebyshev

open polynomial

variables (R S : Type*) [comm_ring R] [comm_ring S]

/-- `T n` is the `n`-th Chebyshev polynomial of the first kind -/
noncomputable def T : ℕ → polynomial R
| 0       := 1
| 1       := X
| (n + 2) := 2 * X * T (n + 1) - T n

@[simp] lemma T_zero : T R 0 = 1 := rfl
@[simp] lemma T_one : T R 1 = X := rfl
lemma T_two : T R 2 = 2 * X ^ 2 - 1 :=
by simp only [T, sub_left_inj, sq, mul_assoc]
@[simp] lemma T_add_two (n : ℕ) :
  T R (n + 2) = 2 * X * T R (n + 1) - T R n :=
by rw T

lemma T_of_two_le (n : ℕ) (h : 2 ≤ n) :
  T R n = 2 * X * T R (n - 1) - T R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact T_add_two R n
end

variables {R S}

lemma map_T (f : R →+* S) :
  ∀ (n : ℕ), map f (T R n) = T S n
| 0       := by simp only [T_zero, polynomial.map_one]
| 1       := by simp only [T_one, map_X]
| (n + 2) :=
begin
  simp only [T_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0,
             polynomial.map_add, polynomial.map_one],
  rw [map_T (n + 1), map_T n],
end

variables (R S)

/-- `U n` is the `n`-th Chebyshev polynomial of the second kind -/
noncomputable def U : ℕ → polynomial R
| 0       := 1
| 1       := 2 * X
| (n + 2) := 2 * X * U (n + 1) - U n

@[simp] lemma U_zero : U R 0 = 1 := rfl
@[simp] lemma U_one : U R 1 = 2 * X := rfl

@[simp] lemma U_add_two (n : ℕ) :
  U R (n + 2) = 2 * X * U R (n + 1) - U R n :=
by rw U

lemma U_of_two_le (n : ℕ) (h : 2 ≤ n) :
  U R n = 2 * X * U R (n - 1) - U R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact U_add_two R n
end

lemma U_eq_X_mul_U_add_T :
  ∀ (n : ℕ), U R (n+1) = X * U R n + T R (n+1)
| 0        := by { simp only [U_zero, U_one, T_one], ring }
| 1        := by { simp only [U_one, T_two, U_two], ring }
| (n + 2)  :=
  calc U R (n + 2 + 1) = 2 * X * (X * U R (n + 1) + T R (n + 2)) - (X * U R n + T R (n + 1)) :
            by simp only [U_add_two, U_eq_X_mul_U_add_T n, U_eq_X_mul_U_add_T (n + 1)]
  ... = X * (2 * X * U R (n + 1) - U R n) + (2 * X * T R (n + 2) - T R (n + 1)) : by ring
  ... = X * U R (n + 2) + T R (n + 2 + 1) : by simp only [U_add_two, T_add_two]

lemma T_eq_U_sub_X_mul_U (n : ℕ) :
  T R (n+1) = U R (n+1) - X * U R n :=
by rw [U_eq_X_mul_U_add_T, add_comm (X * U R n), add_sub_cancel]

lemma T_eq_X_mul_T_sub_pol_U :
  ∀ (n : ℕ), T R (n+2) = X * T R (n+1) - (1 - X ^ 2) * U R n
| 0        := by { simp only [T_one, T_two, U_zero], ring }
| 1        := by { simp only [T_add_two, T_zero, T_add_two,
                              U_one, T_one], ring }
| (n + 2)  :=
calc T R (n + 2 + 2)
    = 2 * X * T R (n + 2 + 1) - T R (n + 2) : T_add_two _ _
... = 2 * X * (X * T R (n + 2) - (1 - X ^ 2) * U R (n + 1))
      - (X * T R (n + 1) - (1 - X ^ 2) * U R n) : by simp only [T_eq_X_mul_T_sub_pol_U]
... = X * (2 * X * T R (n + 2) -  T R (n + 1)) - (1 - X ^ 2) * (2 * X * U R (n + 1) - U R n) :
            by ring
... = X * T R (n + 2 + 1) - (1 - X ^ 2) * U R (n + 2) : by rw [T_add_two _ (n + 1), U_add_two]

lemma one_sub_X_sq_mul_U_eq_pol_in_T (n : ℕ) :
  (1 - X ^ 2) * U R n = X * T R (n + 1) - T R (n + 2) :=
by rw [T_eq_X_mul_T_sub_pol_U, ←sub_add, sub_self, zero_add]

variables {R S}

@[simp] lemma map_U (f : R →+* S) :
  ∀ (n : ℕ), map f (U R n) = U S n
| 0       := by simp only [U_zero, polynomial.map_one]
| 1       :=
begin
  simp only [U_one, map_X, polynomial.map_mul, polynomial.map_add, polynomial.map_one],
  change map f (1+1) * X = 2 * X,
  simpa only [polynomial.map_add, polynomial.map_one]
end
| (n + 2) :=
begin
  simp only [U_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0, polynomial.map_add,
             polynomial.map_one],
  rw [map_U (n + 1), map_U n],
end

lemma T_derivative_eq_U :
  ∀ (n : ℕ), derivative (T R (n + 1)) = (n + 1) * U R n
| 0        := by simp only [T_one, U_zero, derivative_X, nat.cast_zero, zero_add, mul_one]
| 1        := by { simp only [T_two, U_one, derivative_sub, derivative_one, derivative_mul,
                              derivative_X_pow, nat.cast_one, nat.cast_two],
                    norm_num }
| (n + 2)  :=
  calc derivative (T R (n + 2 + 1))
      = 2 * T R (n + 2) + 2 * X * derivative (T R (n + 1 + 1)) - derivative (T R (n + 1)) :
              by simp only [T_add_two _ (n + 1), derivative_sub, derivative_mul, derivative_X,
                            derivative_bit0, derivative_one, bit0_zero, zero_mul, zero_add, mul_one]
  ... = 2 * (U R (n + 1 + 1) - X * U R (n + 1)) + 2 * X * ((n + 1 + 1) * U R (n + 1))
        - (n + 1) * U R n : by rw_mod_cast [T_derivative_eq_U, T_derivative_eq_U,
                                            T_eq_U_sub_X_mul_U]
  ... = (n + 1) * (2 * X * U R (n + 1) - U R n) + 2 * U R (n + 2) : by ring
  ... = (n + 1) * U R (n + 2) + 2 * U R (n + 2) : by rw U_add_two
  ... = (n + 2 + 1) * U R (n + 2) : by ring
  ... = (↑(n + 2) + 1) * U R (n + 2) : by norm_cast

lemma one_sub_X_sq_mul_derivative_T_eq_poly_in_T (n : ℕ) :
  (1 - X ^ 2)  * (derivative (T R (n+1))) =
    (n + 1) * (T R n - X * T R (n+1)) :=
  calc
  (1 - X ^ 2)  * (derivative (T R (n+1))) = (1 - X ^ 2 ) * ((n + 1) * U R n) :
            by rw T_derivative_eq_U
  ... = (n + 1) * ((1 - X ^ 2) * U R n) : by ring
  ... = (n + 1) * (X * T R (n + 1) - (2 * X * T R (n + 1) - T R n)) :
            by rw [one_sub_X_sq_mul_U_eq_pol_in_T, T_add_two]
  ... = (n + 1) * (T R n - X * T R (n+1)) : by ring

lemma add_one_mul_T_eq_poly_in_U (n : ℕ) :
  ((n : polynomial R) + 1) * T R (n+1) =
    X * U R n - (1 - X ^ 2) * derivative ( U R n) :=
begin
  have h : derivative (T R (n + 2)) = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
                                      + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n),
  { conv_lhs { rw T_eq_X_mul_T_sub_pol_U },
  simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
  one_mul, T_derivative_eq_U],
  rw [T_eq_U_sub_X_mul_U, nat.cast_bit0, nat.cast_one],
  ring },
  calc ((n : polynomial R) + 1) * T R (n + 1)
      = ((n : polynomial R) + 1 + 1) * (X * U R n + T R (n + 1))
        - X * ((n + 1) * U R n) - (X * U R n + T R (n + 1)) : by ring
  ... = derivative (T R (n + 2)) - X * derivative (T R (n + 1)) - U R (n + 1) :
            by rw [←U_eq_X_mul_U_add_T, ←T_derivative_eq_U, ←nat.cast_one, ←nat.cast_add,
                  nat.cast_one, ←T_derivative_eq_U (n + 1)]
  ... = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
        + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n)
        - X * derivative (T R (n + 1)) - U R (n + 1) : by rw h
  ... = X * U R n - (1 - X ^ 2) * derivative (U R n) : by ring,
end

variables (R)

/-- The product of two Chebyshev polynomials is the sum of two other Chebyshev polynomials. -/
lemma mul_T :
  ∀ m : ℕ, ∀ k,
  2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
| 0 := by simp [two_mul, add_mul]
| 1 := by simp [add_comm]
| (m + 2) := begin
  intros k,
  -- clean up the `T` nat indices in the goal
  suffices : 2 * T R (m + 2) * T R (m + k + 2) = T R (2 * m + k + 4) + T R k,
  { have h_nat₁ : 2 * (m + 2) + k = 2 * m + k + 4 := by ring,
    have h_nat₂ : m + 2 + k = m + k + 2 := by simp [add_comm, add_assoc],
    simpa [h_nat₁, h_nat₂] using this },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m + 1` and
  -- `k + 1`
  have H₁ : 2 * T R (m + 1) * T R (m + k + 2) = T R (2 * m + k + 3) + T R (k + 1),
  { have h_nat₁ : m + 1 + (k + 1) = m + k + 2 := by ring,
    have h_nat₂ : 2 * (m + 1) + (k + 1) = 2 * m + k + 3 := by ring,
    simpa [h_nat₁, h_nat₂] using mul_T (m + 1) (k + 1) },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m` and `k + 2`
  have H₂ : 2 * T R m * T R (m + k + 2) = T R (2 * m + k + 2) + T R (k + 2),
  { have h_nat₁ : 2 * m + (k + 2) = 2 * m + k + 2 := by simp [add_assoc],
    have h_nat₂ : m + (k + 2) = m + k + 2 := by simp [add_assoc],
    simpa [h_nat₁, h_nat₂] using mul_T m (k + 2) },
  -- state the `T` recurrence relation for a few useful indices
  have h₁ := T_add_two R m,
  have h₂ := T_add_two R (2 * m + k + 2),
  have h₃ := T_add_two R k,
  -- the desired identity is an appropriate linear combination of H₁, H₂, h₁, h₂, h₃
  linear_combination (h₁, 2 * T R (m + k + 2)) (H₁, 2 * X) (H₂, -1) (h₂, -1) (h₃, -1),
end

/-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
lemma T_mul :
  ∀ m : ℕ, ∀ n : ℕ, T R (m * n) = (T R m).comp (T R n)
| 0 := by simp
| 1 := by simp
| (m + 2) := begin
  intros n,
  have : 2 * T R n * T R ((m + 1) * n) = T R ((m + 2) * n) + T R (m * n),
  { convert mul_T R n (m * n); ring },
  simp [this, T_mul m, ← T_mul (m + 1)]
end

end polynomial.chebyshev


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Scott Morrison
-/
import category_theory.monoidal.braided
import algebra.category.Module.basic
import linear_algebra.tensor_product

/-!
# The symmetric monoidal category structure on R-modules

Mostly this uses existing machinery in `linear_algebra.tensor_product`.
We just need to provide a few small missing pieces to build the
`monoidal_category` instance and then the `symmetric_category` instance.

If you're happy using the bundled `Module R`, it may be possible to mostly
use this as an interface and not need to interact much with the implementation details.
-/

universes u

open category_theory

namespace Module

variables {R : Type u} [comm_ring R]

namespace monoidal_category
-- The definitions inside this namespace are essentially private.
-- After we build the `monoidal_category (Module R)` instance,
-- you should use that API.

open_locale tensor_product

/-- (implementation) tensor product of R-modules -/
def tensor_obj (M N : Module R) : Module R := Module.of R (M ⊗[R] N)
/-- (implementation) tensor product of morphisms R-modules -/
def tensor_hom {M N M' N' : Module R} (f : M ⟶ N) (g : M' ⟶ N') :
  tensor_obj M M' ⟶ tensor_obj N N' :=
tensor_product.map f g

lemma tensor_id (M N : Module R) : tensor_hom (𝟙 M) (𝟙 N) = 𝟙 (Module.of R (↥M ⊗ ↥N)) :=
by tidy

lemma tensor_comp {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : Module R}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) :
    tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom f₁ f₂ ≫ tensor_hom g₁ g₂ :=
by tidy

/-- (implementation) the associator for R-modules -/
def associator (M N K : Module R) : tensor_obj (tensor_obj M N) K ≅ tensor_obj M (tensor_obj N K) :=
linear_equiv.to_Module_iso (tensor_product.assoc R M N K)

section

/-! The `associator_naturality` and `pentagon` lemmas below are very slow to elaborate.

We give them some help by expressing the lemmas first non-categorically, then using
`convert _aux using 1` to have the elaborator work as little as possible. -/

open tensor_product (assoc map)

private lemma associator_naturality_aux
  {X₁ X₂ X₃ : Type*}
  [add_comm_monoid X₁] [add_comm_monoid X₂] [add_comm_monoid X₃]
  [module R X₁] [module R X₂] [module R X₃]
  {Y₁ Y₂ Y₃ : Type*}
  [add_comm_monoid Y₁] [add_comm_monoid Y₂] [add_comm_monoid Y₃]
  [module R Y₁] [module R Y₂] [module R Y₃]
  (f₁ : X₁ →ₗ[R] Y₁) (f₂ : X₂ →ₗ[R] Y₂) (f₃ : X₃ →ₗ[R] Y₃) :
  linear_map.comp ↑(assoc R Y₁ Y₂ Y₃) (map (map f₁ f₂) f₃) =
    (map f₁ (map f₂ f₃)).comp ↑(assoc R X₁ X₂ X₃) :=
begin
  apply tensor_product.ext_threefold,
  intros x y z,
  refl
end

variables (R)

private lemma pentagon_aux
  (W X Y Z : Type*)
  [add_comm_monoid W] [add_comm_monoid X] [add_comm_monoid Y] [add_comm_monoid Z]
  [module R W] [module R X] [module R Y] [module R Z] :
  ((map (1 : W →ₗ[R] W) (assoc R X Y Z).to_linear_map).comp (assoc R W (X ⊗[R] Y) Z).to_linear_map)
    .comp (map ↑(assoc R W X Y) (1 : Z →ₗ[R] Z)) =
  (assoc R W X (Y ⊗[R] Z)).to_linear_map.comp (assoc R (W ⊗[R] X) Y Z).to_linear_map :=
begin
  apply tensor_product.ext_fourfold,
  intros w x y z,
  refl
end

end

lemma associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : Module R}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) :
    tensor_hom (tensor_hom f₁ f₂) f₃ ≫ (associator Y₁ Y₂ Y₃).hom =
    (associator X₁ X₂ X₃).hom ≫ tensor_hom f₁ (tensor_hom f₂ f₃) :=
by convert associator_naturality_aux f₁ f₂ f₃ using 1

lemma pentagon (W X Y Z : Module R) :
  tensor_hom (associator W X Y).hom (𝟙 Z) ≫ (associator W (tensor_obj X Y) Z).hom
  ≫ tensor_hom (𝟙 W) (associator X Y Z).hom =
    (associator (tensor_obj W X) Y Z).hom ≫ (associator W X (tensor_obj Y Z)).hom :=
by convert pentagon_aux R W X Y Z using 1

/-- (implementation) the left unitor for R-modules -/
def left_unitor (M : Module.{u} R) : Module.of R (R ⊗[R] M) ≅ M :=
(linear_equiv.to_Module_iso (tensor_product.lid R M) : of R (R ⊗ M) ≅ of R M).trans (of_self_iso M)

/-- (implementation) the right unitor for R-modules -/
def right_unitor (M : Module.{u} R) : Module.of R (M ⊗[R] R) ≅ M :=
(linear_equiv.to_Module_iso (tensor_product.rid R M) : of R (M ⊗ R) ≅ of R M).trans (of_self_iso M)

lemma right_unitor_naturality {M N : Module R} (f : M ⟶ N) :
  tensor_hom f (𝟙 (Module.of R R)) ≫ (right_unitor N).hom = (right_unitor M).hom ≫ f :=
begin
  ext x y, simp,
  erw [tensor_product.rid_tmul, tensor_product.rid_tmul],
  rw linear_map.map_smul,
  refl,
end

lemma triangle (M N : Module.{u} R) :
  (associator M (Module.of R R) N).hom ≫ tensor_hom (𝟙 M) (left_unitor N).hom =
    tensor_hom (right_unitor M).hom (𝟙 N) :=
begin
  apply tensor_product.ext_threefold,
  intros x y z,
  change R at y,
  dsimp [tensor_hom, associator],
  erw [tensor_product.lid_tmul, tensor_product.rid_tmul],
  exact (tensor_product.smul_tmul _ _ _).symm
end

end monoidal_category

open monoidal_category

instance monoidal_category : monoidal_category (Module.{u} R) :=
{ -- data
  tensor_obj   := tensor_obj,
  tensor_hom   := @tensor_hom _ _,
  tensor_unit  := Module.of R R,
  associator   := associator,
  left_unitor  := left_unitor,
  right_unitor := right_unitor,
  -- properties
  tensor_id'               := λ M N, tensor_id M N,
  tensor_comp'             := λ M N K M' N' K' f g h, tensor_comp f g h,
  associator_naturality'   := λ M N K M' N' K' f g h, associator_naturality f g h,
  left_unitor_naturality'  := λ M N f, left_unitor_naturality f,
  right_unitor_naturality' := λ M N f, right_unitor_naturality f,
  pentagon'                := λ M N K L, pentagon M N K L,
  triangle'                := λ M N, triangle M N, }

/-- Remind ourselves that the monoidal unit, being just `R`, is still a commutative ring. -/
instance : comm_ring ((𝟙_ (Module.{u} R) : Module.{u} R) : Type u) :=
(by apply_instance : comm_ring R)

namespace monoidal_category

@[simp]
lemma hom_apply {K L M N : Module.{u} R} (f : K ⟶ L) (g : M ⟶ N) (k : K) (m : M) :
  (f ⊗ g) (k ⊗ₜ m) = f k ⊗ₜ g m := rfl

@[simp]
lemma left_unitor_hom_apply {M : Module.{u} R} (r : R) (m : M) :
  ((λ_ M).hom : 𝟙_ (Module R) ⊗ M ⟶ M) (r ⊗ₜ[R] m) = r • m :=
tensor_product.lid_tmul m r

@[simp]
lemma right_unitor_hom_apply {M : Module.{u} R} (m : M) (r : R) :
  ((ρ_ M).hom : M ⊗ 𝟙_ (Module R) ⟶ M) (m ⊗ₜ r) = r • m :=
tensor_product.rid_tmul m r

@[simp]
lemma associator_hom_apply {M N K : Module.{u} R} (m : M) (n : N) (k : K) :
  ((α_ M N K).hom : (M ⊗ N) ⊗ K ⟶ M ⊗ (N ⊗ K)) ((m ⊗ₜ n) ⊗ₜ k) = (m ⊗ₜ (n ⊗ₜ k)) := rfl

end monoidal_category

/-- (implementation) the braiding for R-modules -/
def braiding (M N : Module R) : tensor_obj M N ≅ tensor_obj N M :=
linear_equiv.to_Module_iso (tensor_product.comm R M N)

@[simp] lemma braiding_naturality {X₁ X₂ Y₁ Y₂ : Module.{u} R} (f : X₁ ⟶ Y₁) (g : X₂ ⟶ Y₂) :
  (f ⊗ g) ≫ (Y₁.braiding Y₂).hom =
    (X₁.braiding X₂).hom ≫ (g ⊗ f) :=
begin
  apply tensor_product.ext,
  intros x y,
  refl
end

@[simp] lemma hexagon_forward (X Y Z : Module.{u} R) :
  (α_ X Y Z).hom ≫ (braiding X _).hom ≫ (α_ Y Z X).hom =
  ((braiding X Y).hom ⊗ 𝟙 Z) ≫ (α_ Y X Z).hom ≫ (𝟙 Y ⊗ (braiding X Z).hom) :=
begin
  apply tensor_product.ext_threefold,
  intros x y z,
  refl,
end

@[simp] lemma hexagon_reverse (X Y Z : Module.{u} R) :
  (α_ X Y Z).inv ≫ (braiding _ Z).hom ≫ (α_ Z X Y).inv =
  (𝟙 X ⊗ (Y.braiding Z).hom) ≫ (α_ X Z Y).inv ≫ ((X.braiding Z).hom ⊗ 𝟙 Y) :=
begin
  apply (cancel_epi (α_ X Y Z).hom).1,
  apply tensor_product.ext_threefold,
  intros x y z,
  refl,
end

/-- The symmetric monoidal structure on `Module R`. -/
instance symmetric_category : symmetric_category (Module.{u} R) :=
{ braiding := braiding,
  braiding_naturality' := λ X₁ X₂ Y₁ Y₂ f g, braiding_naturality f g,
  hexagon_forward' := hexagon_forward,
  hexagon_reverse' := hexagon_reverse, }

namespace monoidal_category

@[simp] lemma braiding_hom_apply {M N : Module.{u} R} (m : M) (n : N) :
  ((β_ M N).hom : M ⊗ N ⟶ N ⊗ M) (m ⊗ₜ n) = n ⊗ₜ m := rfl

@[simp] lemma braiding_inv_apply {M N : Module.{u} R} (m : M) (n : N) :
  ((β_ M N).inv : N ⊗ M ⟶ M ⊗ N) (n ⊗ₜ m) = m ⊗ₜ n := rfl

end monoidal_category

end Module


/-
Copyright (c) 2021 Peter Nelson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Peter Nelson, Yaël Dillies

! This file was ported from Lean 3 source module data.fintype.order
! leanprover-community/mathlib commit 1126441d6bccf98c81214a0780c73d499f6721fe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Lattice
import Mathlib.Data.Finset.Order

/-!
# Order structures on finite types

This file provides order instances on fintypes.

## Computable instances

On a `Fintype`, we can construct
* an `OrderBot` from `SemilatticeInf`.
* an `OrderTop` from `SemilatticeSup`.
* a `BoundedOrder` from `Lattice`.

Those are marked as `def` to avoid defeqness issues.

## Completion instances

Those instances are noncomputable because the definitions of `supₛ` and `infₛ` use `Set.toFinset`
and set membership is undecidable in general.

On a `Fintype`, we can promote:
* a `Lattice` to a `CompleteLattice`.
* a `DistribLattice` to a `CompleteDistribLattice`.
* a `LinearOrder`  to a `CompleteLinearOrder`.
* a `BooleanAlgebra` to a `CompleteBooleanAlgebra`.

Those are marked as `def` to avoid typeclass loops.

## Concrete instances

We provide a few instances for concrete types:
* `Fin.completeLinearOrder`
* `Bool.completeLinearOrder`
* `Bool.completeBooleanAlgebra`
-/

open Finset

namespace Fintype

variable {ι α : Type _} [Fintype ι] [Fintype α]

section Nonempty

variable (α) [Nonempty α]

-- See note [reducible non-instances]
/-- Constructs the `⊥` of a finite nonempty `SemilatticeInf`. -/
@[reducible]
def toOrderBot [SemilatticeInf α] : OrderBot α where
  bot := univ.inf' univ_nonempty id
  bot_le a := inf'_le _ <| mem_univ a
#align fintype.to_order_bot Fintype.toOrderBot

-- See note [reducible non-instances]
/-- Constructs the `⊤` of a finite nonempty `SemilatticeSup` -/
@[reducible]
def toOrderTop [SemilatticeSup α] : OrderTop α where
  top := univ.sup' univ_nonempty id
  -- Porting note: needed to make `id` explicit
  le_top a := le_sup' id <| mem_univ a
#align fintype.to_order_top Fintype.toOrderTop

-- See note [reducible non-instances]
/-- Constructs the `⊤` and `⊥` of a finite nonempty `Lattice`. -/
@[reducible]
def toBoundedOrder [Lattice α] : BoundedOrder α :=
  { toOrderBot α, toOrderTop α with }
#align fintype.to_bounded_order Fintype.toBoundedOrder

end Nonempty

section BoundedOrder

variable (α)

open Classical

-- See note [reducible non-instances]
/-- A finite bounded lattice is complete. -/
@[reducible]
noncomputable def toCompleteLattice [Lattice α] [BoundedOrder α] : CompleteLattice α :=
  { ‹Lattice α›,
    ‹BoundedOrder α› with
    supₛ := fun s => s.toFinset.sup id
    infₛ := fun s => s.toFinset.inf id
    le_supₛ := fun _ _ ha => Finset.le_sup (f := id) (Set.mem_toFinset.mpr ha)
    supₛ_le := fun s _ ha => Finset.sup_le fun b hb => ha _ <| Set.mem_toFinset.mp hb
    infₛ_le := fun _ _ ha => Finset.inf_le (Set.mem_toFinset.mpr ha)
    le_infₛ := fun s _ ha => Finset.le_inf fun b hb => ha _ <| Set.mem_toFinset.mp hb }
#align fintype.to_complete_lattice Fintype.toCompleteLattice

-- Porting note: `convert` doesn't work as well as it used to.
-- See note [reducible non-instances]
/-- A finite bounded distributive lattice is completely distributive. -/
@[reducible]
noncomputable def toCompleteDistribLattice [DistribLattice α] [BoundedOrder α] :
    CompleteDistribLattice α :=
  { toCompleteLattice α with
    infᵢ_sup_le_sup_infₛ := fun a s => by
      convert (Finset.inf_sup_distrib_left s.toFinset id a).ge using 1
      rw [Finset.inf_eq_infᵢ]
      simp_rw [Set.mem_toFinset]
      rfl
    inf_supₛ_le_supᵢ_inf := fun a s => by
      convert (Finset.sup_inf_distrib_left s.toFinset id a).le using 1
      rw [Finset.sup_eq_supᵢ]
      simp_rw [Set.mem_toFinset]
      rfl }
#align fintype.to_complete_distrib_lattice Fintype.toCompleteDistribLattice

-- See note [reducible non-instances]
/-- A finite bounded linear order is complete. -/
@[reducible]
noncomputable def toCompleteLinearOrder [LinearOrder α] [BoundedOrder α] : CompleteLinearOrder α :=
  { toCompleteLattice α, ‹LinearOrder α› with }
#align fintype.to_complete_linear_order Fintype.toCompleteLinearOrder

-- See note [reducible non-instances]
/-- A finite boolean algebra is complete. -/
@[reducible]
noncomputable def toCompleteBooleanAlgebra [BooleanAlgebra α] : CompleteBooleanAlgebra α :=
  -- Porting note: using `Fintype.toCompleteDistribLattice α` caused timeouts
  { Fintype.toCompleteLattice α,
    ‹BooleanAlgebra α› with
    infᵢ_sup_le_sup_infₛ := fun a s => by
      convert (Finset.inf_sup_distrib_left s.toFinset id a).ge using 1
      rw [Finset.inf_eq_infᵢ]
      simp_rw [Set.mem_toFinset]
      rfl
    inf_supₛ_le_supᵢ_inf := fun a s => by
      convert (Finset.sup_inf_distrib_left s.toFinset id a).le using 1
      rw [Finset.sup_eq_supᵢ]
      simp_rw [Set.mem_toFinset]
      rfl }
#align fintype.to_complete_boolean_algebra Fintype.toCompleteBooleanAlgebra

end BoundedOrder

section Nonempty

variable (α) [Nonempty α]

-- See note [reducible non-instances]
/-- A nonempty finite lattice is complete. If the lattice is already a `BoundedOrder`, then use
`Fintype.toCompleteLattice` instead, as this gives definitional equality for `⊥` and `⊤`. -/
@[reducible]
noncomputable def toCompleteLatticeOfNonempty [Lattice α] : CompleteLattice α :=
  @toCompleteLattice _ _ _ <| @toBoundedOrder α _ ⟨Classical.arbitrary α⟩ _
#align fintype.to_complete_lattice_of_nonempty Fintype.toCompleteLatticeOfNonempty

-- See note [reducible non-instances]
/-- A nonempty finite linear order is complete. If the linear order is already a `BoundedOrder`,
then use `Fintype.toCompleteLinearOrder` instead, as this gives definitional equality for `⊥` and
`⊤`. -/
@[reducible]
noncomputable def toCompleteLinearOrderOfNonempty [LinearOrder α] : CompleteLinearOrder α :=
  { toCompleteLatticeOfNonempty α, ‹LinearOrder α› with }
#align fintype.to_complete_linear_order_of_nonempty Fintype.toCompleteLinearOrderOfNonempty

end Nonempty

end Fintype

/-! ### Concrete instances -/

noncomputable instance Fin.completeLinearOrder {n : ℕ} : CompleteLinearOrder (Fin (n + 1)) :=
  Fintype.toCompleteLinearOrder _

noncomputable instance Bool.completeLinearOrder : CompleteLinearOrder Bool :=
  Fintype.toCompleteLinearOrder _

noncomputable instance Bool.completeBooleanAlgebra : CompleteBooleanAlgebra Bool :=
  Fintype.toCompleteBooleanAlgebra _

/-! ### Directed Orders -/

variable {α : Type _}

theorem Directed.fintype_le {r : α → α → Prop} [IsTrans α r] {β γ : Type _} [Nonempty γ] {f : γ → α}
    [Fintype β] (D : Directed r f) (g : β → γ) : ∃ z, ∀ i, r (f (g i)) (f z) := by
  classical
    obtain ⟨z, hz⟩ := D.finset_le (Finset.image g Finset.univ)
    exact ⟨z, fun i => hz (g i) (Finset.mem_image_of_mem g (Finset.mem_univ i))⟩
#align directed.fintype_le Directed.fintype_le

theorem Fintype.exists_le [Nonempty α] [Preorder α] [IsDirected α (· ≤ ·)] {β : Type _} [Fintype β]
    (f : β → α) : ∃ M, ∀ i, f i ≤ M :=
  directed_id.fintype_le _
#align fintype.exists_le Fintype.exists_le

theorem Fintype.bddAbove_range [Nonempty α] [Preorder α] [IsDirected α (· ≤ ·)] {β : Type _}
    [Fintype β] (f : β → α) : BddAbove (Set.range f) := by
  obtain ⟨M, hM⟩ := Fintype.exists_le f
  refine' ⟨M, fun a ha => _⟩
  obtain ⟨b, rfl⟩ := ha
  exact hM b
#align fintype.bdd_above_range Fintype.bddAbove_range


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl
-/
import algebra.category.Ring.basic
import data.mv_polynomial.comm_ring

/-!
Multivariable polynomials on a type is the left adjoint of the
forgetful functor from commutative rings to types.
-/

noncomputable theory

universe u

open mv_polynomial
open category_theory

namespace CommRing

open_locale classical

/--
The free functor `Type u ⥤ CommRing` sending a type `X` to the multivariable (commutative)
polynomials with variables `x : X`.
-/
def free : Type u ⥤ CommRing.{u} :=
{ obj := λ α, of (mv_polynomial α ℤ),
  map := λ X Y f,
    (↑(rename f : _ →ₐ[ℤ] _) : (mv_polynomial X ℤ →+* mv_polynomial Y ℤ)),
  -- TODO these next two fields can be done by `tidy`, but the calls in `dsimp` and `simp` it
  -- generates are too slow.
  map_id' := λ X, ring_hom.ext $ rename_id,
  map_comp' := λ X Y Z f g, ring_hom.ext $ λ p, (rename_rename f g p).symm }

@[simp] lemma free_obj_coe {α : Type u} :
  (free.obj α : Type u) = mv_polynomial α ℤ := rfl

@[simp]

/--
The free-forgetful adjunction for commutative rings.
-/
def adj : free ⊣ forget CommRing.{u} :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X R, hom_equiv,
  hom_equiv_naturality_left_symm' :=
    λ _ _ Y f g, ring_hom.ext $ λ x, eval₂_cast_comp f (int.cast_ring_hom Y) g x }

instance : is_right_adjoint (forget CommRing.{u}) := ⟨_, adj⟩

end CommRing


import tactic

example {α : Type*} (p q : α → Prop) :
  (∃ x, p x ∨ q x) → (∃ x, p x) ∨ (∃ x, q x)
| (Exists.intro x (or.inl px)) := or.inl (exists.intro x px)
| (Exists.intro x (or.inr qx)) := or.inr (exists.intro x qx)

namespace pattern_matching

  def bnot : bool → bool
  | tt := ff
  | ff := tt

  #print bnot._main

  theorem bnot_bnot : ∀ (b : bool), bnot (bnot b) = b
  | tt := rfl    -- proof that bnot (bnot tt) = tt
  | ff := rfl    -- proof that bnot (bnot ff) = ff

  example (p q : Prop) : p ∧ q → q ∧ p
  | (and.intro h₁ h₂) := and.intro h₂ h₁

  example (p q : Prop) : p ∨ q → q ∨ p
  | (or.inl hp) := or.inr hp
  | (or.inr hq) := or.inl hq

  open nat

  def sub2 : ℕ → ℕ
  | 0     := 0
  | 1     := 0
  | (a+2) := a

  example : sub2 0 = 0 := rfl
  example : sub2 1 = 0 := rfl
  example (a : nat) : sub2 (a + 2) = a := rfl

  example : sub2 5 = 3 := rfl

  #print sub2
  #print sub2._main

  #check @nat.rec_on
  #check @nat.cases_on

  def {u} moop : Π {C : ℕ → Sort u} (n : ℕ), C 0 → (Π (m : ℕ), C m.succ) → C n := @nat.cases_on

  /-
  The defintion of `sub2` above is equivalent to `sub2'` below. Let's think about how this works.

  We use the `nat.cases_on` eliminator applied to `n`. Recall that `@nat.cases_on` has type

    `Π {C : ℕ → Sort u} (n : ℕ), C 0 → (Π (m : ℕ), C m.succ) → C n`

  In our application, `C : ℕ → Type` is the (dependent) function `λ (z : ℕ), ℕ`.

  Thus `C 0` is the type `ℕ` and `(Π (m : ℕ), C m.succ)` is `Π (m : ℕ), ℕ`, i.e. `ℕ → ℕ`.

  In the case where `n` is `0`, we return `0`, meaning that `sub2' 0 = 0`.

  Next, we must give a term of type `ℕ → ℕ` representing the function that takes `m` to
  `sub2' (succ m)`

  We next have a term of type `Π (n : ℕ), C n.succ`, where (in our case) `C : ℕ → Type` is the
  function `λ (z : ℕ), ℕ`. That is, we have a term of type `Π (n : ℕ) : ℕ`.

  Write `λ m, f m` for this function. We want `f 0 = 0` (i.e. `sub2' (succ 0) = 0`) and
  we want `f (succ p) = p` (i.e. we want `sub2' (succ (succ p)) = p`).

  So we take `f m` to be `nat.cases_on 0 (λ p, p)`.
  -/
  def sub2' (n : ℕ) : ℕ := nat.cases_on n 0 (λ m, nat.cases_on m 0 (λ p, p))

  /-
  The same function can be defined using `nat.rec_on`.
  -/
  def sub2'' (n : ℕ) : ℕ := nat.rec_on n 0 (λ m _, nat.rec_on m 0 (λ p _, p))

  example : sub2' 0 = 0 := rfl
  example (n : ℕ) : sub2' (succ n) = nat.cases_on n 0 (λ p, p) := rfl
  example (n : ℕ) : sub2' (succ 0) = 0 := rfl
  example (n : ℕ) : sub2' (succ (succ n)) = n := rfl

  lemma noo1 {α : Type*} (p q : α → Prop) :
    (∃ x, p x ∨ q x) → (∃ x, p x) ∨ (∃ x, q x)
  | (Exists.intro x (or.inl px)) := or.inl (exists.intro x px)
  | (Exists.intro x (or.inr qx)) := or.inr (exists.intro x qx)

  #print noo1

  /-
  Processing of multiple arguments sequentially.
  -/
  def foo : ℕ → ℕ → ℕ
  | 0     n     := 0
  | (m+1) 0     := 1
  | (m+1) (n+1) := 2

  /-
  Here we see the use of wildcards in defining binomial coefficients.
  -/
  def binom : ℕ → ℕ → ℕ
  | _     0     := 1
  | 0     (n+1) := 0
  | (n+1) (k+1) := binom n k + binom n (k+1)

end pattern_matching

namespace wildcards_and_overlapping_patterns

  /-
  We can use overlapping patterns to define binomial coefficients.
  -/
  def binom : ℕ → ℕ → ℕ
  | _     0     := 1
  | 0     _     := 0
  | (n+1) (k+1) := binom n k + binom n (k+1)

  -- Note that the first of the patterns above is used in computing `binom 0 0`.
  example : binom 0 0 = 1 := rfl

  -- Every inhabited type has an arbitrary value. We can use this to define a function.
  def f1 : ℕ → ℕ → ℕ
  | 0  _  := 1
  | _  0  := 2
  | _  _  := arbitrary ℕ   -- the "incomplete" case

  example : f1 3 5 = arbitrary ℕ := rfl

  -- Here's a more general version.
  def f1' {R : Type} [inhabited R] : R := arbitrary R

end wildcards_and_overlapping_patterns

namespace structural_recursion_and_induction

  section addition_and_multiplication

  open nat

  def add : nat → nat → nat
  | m zero     := m
  | m (succ n) := succ (add m n)

    local infix ` + ` := add

    theorem add_zero (m : nat) : m + zero = m := rfl
    theorem add_succ (m n : nat) : m + succ n = succ (m + n) := rfl

    /-
    To understand the second line below, realise that the goal is to prove `0 + (succ n) = succ n`.
    Definitionally, `0 + (succ n) = succ (0 + n)`, so we must prove `succ (0 + n) = succ n`.
    This is where `congr_arg` comes into play.
    -/
    theorem zero_add : ∀ n, zero + n = n
    | zero     := rfl
    | (succ n) := congr_arg succ (zero_add n)

    def mul : nat → nat → nat
    | n zero     := zero
    | n (succ m) := mul n m + n

    /-
    The idea with the function defintion below is that we fix a parameter `m` and then define
    a function `mul' : nat → nat` that represents 'muliplty by m'.
    -/
    def mul' (m : ℕ) : nat → nat
    | zero       := zero
    | (succ n)   := (mul' n) + m

  end addition_and_multiplication

  /-
  See the file `08b_course_of_values_recursion.lean` for a discussion of course-of-values recursion.
  -/

end structural_recursion_and_induction

namespace well_founded_recursion

  universe u

  /-
  Let `α : Sort u` be a sort and let `r : α → α → Prop` be a relation. Then `acc r` is an inductive
  family of types.

  For each `x : α`, the type `acc r x` represents the notion that `x` is 'accessible' wrt the
  relation `r`. For `x` to be accessible means that for every `y : α`, if `r y x`, then `y`
  is accessible. This notion is expressed via the single contructor of `acc`.
  -/
  inductive acc {α : Sort u} (r : α → α → Prop) : α → Prop
  | intro (x : α) (h : ∀ y, r y x → acc y) : acc x

  /-
  As a practical example, we'll take `α` to be `ℕ` and `r` to be the less than relation on `ℕ `,
  We give several proofs of `acc r 0`.

  Assuming `y : ℕ` and `hy : α, y < 0`, we must proove `acc r y`. But `hy` leads to a contradiction.

  More generally, whatever relation `r` we have, if `x` has no 'predecessor', then we can deduce
  `acc r x`.
  -/

  def r := λ (m n : ℕ), m < n

  example : acc r 0 := acc.intro 0 (λ y hy, absurd hy (nat.not_lt_zero y)) -- most detailed proof.
  example : acc r 0 := ⟨0, λ y hy, absurd hy (nat.not_lt_zero y)⟩ -- anonymous constructor.
  lemma acc_lt_zero : acc r 0 := ⟨0, λ y hy, by {unfold r at hy, linarith}⟩ -- Using `linarith`.
  example : acc r 0 := -- Tactic-based proof.
  begin
    existsi 0, -- `split` also works
    intros y hy, unfold r at hy, linarith,
  end

  /-
  Using the above, we'll prove that `1` is accessible.
  -/
  lemma acc_lt_one : acc r 1 := ⟨1,
    λ y hy,
    have h : y = 0, from nat.le_zero_iff.mp (nat.lt_succ_iff.mp hy),
    h.symm ▸ acc_lt_zero ⟩

  #check @nat.case_strong_induction_on
  #check @nat.strong_induction_on

  /-
  More generally, we'll show that every natural number is accessible. The proof below seems like a
  bit a of a cheat because the the strong inductionn principle is virtually equivalent to the
  result we're trying to prove!

  I see that the proof of `nat.strong_rec_on` uses a decidability prove. Does this depend
  ultimately on `acc`? I don't know.
  -/
  lemma acc_lt_nat (n : ℕ) : acc r n := nat.strong_induction_on n (λ k hk, ⟨k, hk⟩)

  /-
  Intuitively, `0 : ℤ` is *not* accessible wrt the less-than relation on `ℤ`, though I don't know
  how to prove this!
  -/

end well_founded_recursion