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

! This file was ported from Lean 3 source module analysis.normed_space.spectrum
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Spectrum
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.Analysis.Complex.Liouville
import Mathbin.Analysis.Complex.Polynomial
import Mathbin.Analysis.Analytic.RadiusLiminf
import Mathbin.Topology.Algebra.Module.CharacterSpace
import Mathbin.Analysis.NormedSpace.Exponential

/-!
# The spectrum of elements in a complete normed algebra

This file contains the basic theory for the resolvent and spectrum of a Banach algebra.

## Main definitions

* `spectral_radius : ℝ≥0∞`: supremum of `‖k‖₊` for all `k ∈ spectrum 𝕜 a`
* `normed_ring.alg_equiv_complex_of_complete`: **Gelfand-Mazur theorem** For a complex
  Banach division algebra, the natural `algebra_map ℂ A` is an algebra isomorphism whose inverse
  is given by selecting the (unique) element of `spectrum ℂ a`

## Main statements

* `spectrum.is_open_resolvent_set`: the resolvent set is open.
* `spectrum.is_closed`: the spectrum is closed.
* `spectrum.subset_closed_ball_norm`: the spectrum is a subset of closed disk of radius
  equal to the norm.
* `spectrum.is_compact`: the spectrum is compact.
* `spectrum.spectral_radius_le_nnnorm`: the spectral radius is bounded above by the norm.
* `spectrum.has_deriv_at_resolvent`: the resolvent function is differentiable on the resolvent set.
* `spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius`: Gelfand's formula for the
  spectral radius in Banach algebras over `ℂ`.
* `spectrum.nonempty`: the spectrum of any element in a complex Banach algebra is nonempty.

## TODO

* compute all derivatives of `resolvent a`.

-/

open ENNReal NNReal

/-- The *spectral radius* is the supremum of the `nnnorm` (`‖⬝‖₊`) of elements in the spectrum,
    coerced into an element of `ℝ≥0∞`. Note that it is possible for `spectrum 𝕜 a = ∅`. In this
    case, `spectral_radius a = 0`.  It is also possible that `spectrum 𝕜 a` be unbounded (though
    not for Banach algebras, see `spectrum.is_bounded`, below).  In this case,
    `spectral_radius a = ∞`. -/
noncomputable def spectralRadius (𝕜 : Type _) {A : Type _} [NormedField 𝕜] [Ring A] [Algebra 𝕜 A]
    (a : A) : ℝ≥0∞ :=
  ⨆ k ∈ spectrum 𝕜 a, ‖k‖₊
#align spectral_radius spectralRadius

variable {𝕜 : Type _} {A : Type _}

namespace spectrum

section SpectrumCompact

open Filter

variable [NormedField 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A]

-- mathport name: exprσ
local notation "σ" => spectrum 𝕜

-- mathport name: exprρ
local notation "ρ" => resolventSet 𝕜

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

@[simp]
theorem SpectralRadius.of_subsingleton [Subsingleton A] (a : A) : spectralRadius 𝕜 a = 0 := by
  simp [spectralRadius]
#align spectrum.spectral_radius.of_subsingleton spectrum.SpectralRadius.of_subsingleton

@[simp]
theorem spectralRadius_zero : spectralRadius 𝕜 (0 : A) = 0 :=
  by
  nontriviality A
  simp [spectralRadius]
#align spectrum.spectral_radius_zero spectrum.spectralRadius_zero

theorem mem_resolventSet_of_spectralRadius_lt {a : A} {k : 𝕜} (h : spectralRadius 𝕜 a < ‖k‖₊) :
    k ∈ ρ a :=
  Classical.not_not.mp fun hn => h.not_le <| le_supᵢ₂ k hn
#align spectrum.mem_resolvent_set_of_spectral_radius_lt spectrum.mem_resolventSet_of_spectralRadius_lt

variable [CompleteSpace A]

theorem isOpen_resolventSet (a : A) : IsOpen (ρ a) :=
  Units.isOpen.Preimage ((continuous_algebraMap 𝕜 A).sub continuous_const)
#align spectrum.is_open_resolvent_set spectrum.isOpen_resolventSet

protected theorem isClosed (a : A) : IsClosed (σ a) :=
  (isOpen_resolventSet a).isClosed_compl
#align spectrum.is_closed spectrum.isClosed

theorem mem_resolventSet_of_norm_lt_mul {a : A} {k : 𝕜} (h : ‖a‖ * ‖(1 : A)‖ < ‖k‖) : k ∈ ρ a :=
  by
  rw [resolventSet, Set.mem_setOf_eq, Algebra.algebraMap_eq_smul_one]
  nontriviality A
  have hk : k ≠ 0 :=
    ne_zero_of_norm_ne_zero ((mul_nonneg (norm_nonneg _) (norm_nonneg _)).trans_lt h).ne'
  let ku := Units.map ↑ₐ.toMonoidHom (Units.mk0 k hk)
  rw [← inv_inv ‖(1 : A)‖,
    mul_inv_lt_iff (inv_pos.2 <| norm_pos_iff.2 (one_ne_zero : (1 : A) ≠ 0))] at h
  have hku : ‖-a‖ < ‖(↑ku⁻¹ : A)‖⁻¹ := by simpa [ku, norm_algebraMap] using h
  simpa [ku, sub_eq_add_neg, Algebra.algebraMap_eq_smul_one] using (ku.add (-a) hku).IsUnit
#align spectrum.mem_resolvent_set_of_norm_lt_mul spectrum.mem_resolventSet_of_norm_lt_mul

theorem mem_resolventSet_of_norm_lt [NormOneClass A] {a : A} {k : 𝕜} (h : ‖a‖ < ‖k‖) : k ∈ ρ a :=
  mem_resolventSet_of_norm_lt_mul (by rwa [norm_one, mul_one])
#align spectrum.mem_resolvent_set_of_norm_lt spectrum.mem_resolventSet_of_norm_lt

theorem norm_le_norm_mul_of_mem {a : A} {k : 𝕜} (hk : k ∈ σ a) : ‖k‖ ≤ ‖a‖ * ‖(1 : A)‖ :=
  le_of_not_lt <| mt mem_resolventSet_of_norm_lt_mul hk
#align spectrum.norm_le_norm_mul_of_mem spectrum.norm_le_norm_mul_of_mem

theorem norm_le_norm_of_mem [NormOneClass A] {a : A} {k : 𝕜} (hk : k ∈ σ a) : ‖k‖ ≤ ‖a‖ :=
  le_of_not_lt <| mt mem_resolventSet_of_norm_lt hk
#align spectrum.norm_le_norm_of_mem spectrum.norm_le_norm_of_mem

theorem subset_closedBall_norm_mul (a : A) : σ a ⊆ Metric.closedBall (0 : 𝕜) (‖a‖ * ‖(1 : A)‖) :=
  fun k hk => by simp [norm_le_norm_mul_of_mem hk]
#align spectrum.subset_closed_ball_norm_mul spectrum.subset_closedBall_norm_mul

theorem subset_closedBall_norm [NormOneClass A] (a : A) : σ a ⊆ Metric.closedBall (0 : 𝕜) ‖a‖ :=
  fun k hk => by simp [norm_le_norm_of_mem hk]
#align spectrum.subset_closed_ball_norm spectrum.subset_closedBall_norm

theorem is_bounded (a : A) : Metric.Bounded (σ a) :=
  (Metric.bounded_iff_subset_ball 0).mpr ⟨‖a‖ * ‖(1 : A)‖, subset_closedBall_norm_mul a⟩
#align spectrum.is_bounded spectrum.is_bounded

protected theorem isCompact [ProperSpace 𝕜] (a : A) : IsCompact (σ a) :=
  Metric.isCompact_of_isClosed_bounded (spectrum.isClosed a) (is_bounded a)
#align spectrum.is_compact spectrum.isCompact

theorem spectralRadius_le_nnnorm [NormOneClass A] (a : A) : spectralRadius 𝕜 a ≤ ‖a‖₊ :=
  by
  refine' supᵢ₂_le fun k hk => _
  exact_mod_cast norm_le_norm_of_mem hk
#align spectrum.spectral_radius_le_nnnorm spectrum.spectralRadius_le_nnnorm

theorem exists_nnnorm_eq_spectralRadius_of_nonempty [ProperSpace 𝕜] {a : A} (ha : (σ a).Nonempty) :
    ∃ k ∈ σ a, (‖k‖₊ : ℝ≥0∞) = spectralRadius 𝕜 a :=
  by
  obtain ⟨k, hk, h⟩ := (spectrum.isCompact a).exists_forall_ge ha continuous_nnnorm.continuous_on
  exact ⟨k, hk, le_antisymm (le_supᵢ₂ k hk) (supᵢ₂_le <| by exact_mod_cast h)⟩
#align spectrum.exists_nnnorm_eq_spectral_radius_of_nonempty spectrum.exists_nnnorm_eq_spectralRadius_of_nonempty

theorem spectralRadius_lt_of_forall_lt_of_nonempty [ProperSpace 𝕜] {a : A} (ha : (σ a).Nonempty)
    {r : ℝ≥0} (hr : ∀ k ∈ σ a, ‖k‖₊ < r) : spectralRadius 𝕜 a < r :=
  supₛ_image.symm.trans_lt <|
    ((spectrum.isCompact a).supₛ_lt_iff_of_continuous ha
          (ENNReal.continuous_coe.comp continuous_nnnorm).ContinuousOn (r : ℝ≥0∞)).mpr
      (by exact_mod_cast hr)
#align spectrum.spectral_radius_lt_of_forall_lt_of_nonempty spectrum.spectralRadius_lt_of_forall_lt_of_nonempty

open ENNReal Polynomial

variable (𝕜)

theorem spectralRadius_le_pow_nnnorm_pow_one_div (a : A) (n : ℕ) :
    spectralRadius 𝕜 a ≤ ‖a ^ (n + 1)‖₊ ^ (1 / (n + 1) : ℝ) * ‖(1 : A)‖₊ ^ (1 / (n + 1) : ℝ) :=
  by
  refine' supᵢ₂_le fun k hk => _
  -- apply easy direction of the spectral mapping theorem for polynomials
  have pow_mem : k ^ (n + 1) ∈ σ (a ^ (n + 1)) := by
    simpa only [one_mul, Algebra.algebraMap_eq_smul_one, one_smul, aeval_monomial, one_mul,
      eval_monomial] using subset_polynomial_aeval a (monomial (n + 1) (1 : 𝕜)) ⟨k, hk, rfl⟩
  -- power of the norm is bounded by norm of the power
  have nnnorm_pow_le : (↑(‖k‖₊ ^ (n + 1)) : ℝ≥0∞) ≤ ‖a ^ (n + 1)‖₊ * ‖(1 : A)‖₊ := by
    simpa only [Real.toNNReal_mul (norm_nonneg _), norm_toNNReal, nnnorm_pow k (n + 1),
      ENNReal.coe_mul] using coe_mono (Real.toNNReal_mono (norm_le_norm_mul_of_mem pow_mem))
  -- take (n + 1)ᵗʰ roots and clean up the left-hand side
  have hn : 0 < ((n + 1 : ℕ) : ℝ) := by exact_mod_cast Nat.succ_pos'
  convert monotone_rpow_of_nonneg (one_div_pos.mpr hn).le nnnorm_pow_le
  erw [coe_pow, ← rpow_nat_cast, ← rpow_mul, mul_one_div_cancel hn.ne', rpow_one]
  rw [Nat.cast_succ, ENNReal.coe_mul_rpow]
#align spectrum.spectral_radius_le_pow_nnnorm_pow_one_div spectrum.spectralRadius_le_pow_nnnorm_pow_one_div

theorem spectralRadius_le_liminf_pow_nnnorm_pow_one_div (a : A) :
    spectralRadius 𝕜 a ≤ atTop.liminf fun n : ℕ => (‖a ^ n‖₊ : ℝ≥0∞) ^ (1 / n : ℝ) :=
  by
  refine' ENNReal.le_of_forall_lt_one_mul_le fun ε hε => _
  by_cases ε = 0
  · simp only [h, MulZeroClass.zero_mul, zero_le']
  have hε' : ε⁻¹ ≠ ∞ := fun h' =>
    h (by simpa only [inv_inv, inv_top] using congr_arg (fun x : ℝ≥0∞ => x⁻¹) h')
  simp only [ENNReal.mul_le_iff_le_inv h (hε.trans_le le_top).Ne, mul_comm ε⁻¹,
    liminf_eq_supr_infi_of_nat', ENNReal.supᵢ_mul, ENNReal.infᵢ_mul hε']
  rw [← ENNReal.inv_lt_inv, inv_one] at hε
  obtain ⟨N, hN⟩ :=
    eventually_at_top.mp
      (ENNReal.eventually_pow_one_div_le (ENNReal.coe_ne_top : ↑‖(1 : A)‖₊ ≠ ∞) hε)
  refine' le_trans _ (le_supᵢ _ (N + 1))
  refine' le_infᵢ fun n => _
  simp only [← add_assoc]
  refine' (spectral_radius_le_pow_nnnorm_pow_one_div 𝕜 a (n + N)).trans _
  norm_cast
  exact mul_le_mul_left' (hN (n + N + 1) (by linarith)) _
#align spectrum.spectral_radius_le_liminf_pow_nnnorm_pow_one_div spectrum.spectralRadius_le_liminf_pow_nnnorm_pow_one_div

end SpectrumCompact

section resolvent

open Filter Asymptotics

variable [NontriviallyNormedField 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A] [CompleteSpace A]

-- mathport name: exprρ
local notation "ρ" => resolventSet 𝕜

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

theorem hasDerivAt_resolvent {a : A} {k : 𝕜} (hk : k ∈ ρ a) :
    HasDerivAt (resolvent a) (-resolvent a k ^ 2) k :=
  by
  have H₁ : HasFderivAt Ring.inverse _ (↑ₐ k - a) := hasFderivAt_ring_inverse hk.unit
  have H₂ : HasDerivAt (fun k => ↑ₐ k - a) 1 k := by
    simpa using (Algebra.linearMap 𝕜 A).HasDerivAt.sub_const a
  simpa [resolvent, sq, hk.unit_spec, ← Ring.inverse_unit hk.unit] using H₁.comp_has_deriv_at k H₂
#align spectrum.has_deriv_at_resolvent spectrum.hasDerivAt_resolvent

/- TODO: Once there is sufficient API for bornology, we should get a nice filter / asymptotics
version of this, for example: `tendsto (resolvent a) (cobounded 𝕜) (𝓝 0)` or more specifically
`(resolvent a) =O[cobounded 𝕜] (λ z, z⁻¹)`. -/
theorem norm_resolvent_le_forall (a : A) :
    ∀ ε > 0, ∃ R > 0, ∀ z : 𝕜, R ≤ ‖z‖ → ‖resolvent a z‖ ≤ ε :=
  by
  obtain ⟨c, c_pos, hc⟩ := (@NormedRing.inverse_one_sub_norm A _ _).exists_pos
  rw [is_O_with_iff, eventually_iff, Metric.mem_nhds_iff] at hc
  rcases hc with ⟨δ, δ_pos, hδ⟩
  simp only [CstarRing.norm_one, mul_one] at hδ
  intro ε hε
  have ha₁ : 0 < ‖a‖ + 1 := lt_of_le_of_lt (norm_nonneg a) (lt_add_one _)
  have min_pos : 0 < min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹) :=
    lt_min (mul_pos δ_pos (inv_pos.mpr ha₁)) (mul_pos hε (inv_pos.mpr c_pos))
  refine' ⟨(min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹))⁻¹, inv_pos.mpr min_pos, fun z hz => _⟩
  have hnz : z ≠ 0 := norm_pos_iff.mp (lt_of_lt_of_le (inv_pos.mpr min_pos) hz)
  replace hz := inv_le_of_inv_le min_pos hz
  rcases(⟨Units.mk0 z hnz, Units.val_mk0 hnz⟩ : IsUnit z) with ⟨z, rfl⟩
  have lt_δ : ‖z⁻¹ • a‖ < δ :=
    by
    rw [Units.smul_def, norm_smul, Units.val_inv_eq_inv_val, norm_inv]
    calc
      ‖(z : 𝕜)‖⁻¹ * ‖a‖ ≤ δ * (‖a‖ + 1)⁻¹ * ‖a‖ :=
        mul_le_mul_of_nonneg_right (hz.trans (min_le_left _ _)) (norm_nonneg _)
      _ < δ :=
        by
        conv =>
          rw [mul_assoc]
          rhs
          rw [(mul_one δ).symm]
        exact
          mul_lt_mul_of_pos_left
            ((inv_mul_lt_iff ha₁).mpr ((mul_one (‖a‖ + 1)).symm ▸ lt_add_one _)) δ_pos

  rw [← inv_smul_smul z (resolvent a (z : 𝕜)), units_smul_resolvent_self, resolvent,
    Algebra.algebraMap_eq_smul_one, one_smul, Units.smul_def, norm_smul, Units.val_inv_eq_inv_val,
    norm_inv]
  calc
    _ ≤ ε * c⁻¹ * c :=
      mul_le_mul (hz.trans (min_le_right _ _)) (hδ (mem_ball_zero_iff.mpr lt_δ)) (norm_nonneg _)
        (mul_pos hε (inv_pos.mpr c_pos)).le
    _ = _ := inv_mul_cancel_right₀ c_pos.ne.symm ε

#align spectrum.norm_resolvent_le_forall spectrum.norm_resolvent_le_forall

end resolvent

section OneSubSmul

open ContinuousMultilinearMap ENNReal FormalMultilinearSeries

open NNReal ENNReal

variable [NontriviallyNormedField 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A]

variable (𝕜)

/-- In a Banach algebra `A` over a nontrivially normed field `𝕜`, for any `a : A` the
power series with coefficients `a ^ n` represents the function `(1 - z • a)⁻¹` in a disk of
radius `‖a‖₊⁻¹`. -/
theorem hasFpowerSeriesOnBallInverseOneSubSmul [CompleteSpace A] (a : A) :
    HasFpowerSeriesOnBall (fun z : 𝕜 => Ring.inverse (1 - z • a))
      (fun n => ContinuousMultilinearMap.mkPiField 𝕜 (Fin n) (a ^ n)) 0 ‖a‖₊⁻¹ :=
  { r_le :=
      by
      refine'
        le_of_forall_nnreal_lt fun r hr => le_radius_of_bound_nnreal _ (max 1 ‖(1 : A)‖₊) fun n => _
      rw [← norm_toNNReal, norm_mk_pi_field, norm_toNNReal]
      cases n
      · simp only [le_refl, mul_one, or_true_iff, le_max_iff, pow_zero]
      · refine'
          le_trans (le_trans (mul_le_mul_right' (nnnorm_pow_le' a n.succ_pos) (r ^ n.succ)) _)
            (le_max_left _ _)
        · by_cases ‖a‖₊ = 0
          · simp only [h, MulZeroClass.zero_mul, zero_le', pow_succ]
          · rw [← coe_inv h, coe_lt_coe, NNReal.lt_inv_iff_mul_lt h] at hr
            simpa only [← mul_pow, mul_comm] using pow_le_one' hr.le n.succ
    r_pos := ENNReal.inv_pos.mpr coe_ne_top
    HasSum := fun y hy =>
      by
      have norm_lt : ‖y • a‖ < 1 := by
        by_cases h : ‖a‖₊ = 0
        · simp only [nnnorm_eq_zero.mp h, norm_zero, zero_lt_one, smul_zero]
        · have nnnorm_lt : ‖y‖₊ < ‖a‖₊⁻¹ := by
            simpa only [← coe_inv h, mem_ball_zero_iff, Metric.emetric_ball_nnreal] using hy
          rwa [← coe_nnnorm, ← Real.lt_toNNReal_iff_coe_lt, Real.toNNReal_one, nnnorm_smul, ←
            NNReal.lt_inv_iff_mul_lt h]
      simpa [← smul_pow, (NormedRing.summable_geometric_of_norm_lt_1 _ norm_lt).hasSum_iff] using
        (NormedRing.inverse_oneSub _ norm_lt).symm }
#align spectrum.has_fpower_series_on_ball_inverse_one_sub_smul spectrum.hasFpowerSeriesOnBallInverseOneSubSmul

variable {𝕜}

theorem isUnit_one_sub_smul_of_lt_inv_radius {a : A} {z : 𝕜} (h : ↑‖z‖₊ < (spectralRadius 𝕜 a)⁻¹) :
    IsUnit (1 - z • a) := by
  by_cases hz : z = 0
  · simp only [hz, isUnit_one, sub_zero, zero_smul]
  · let u := Units.mk0 z hz
    suffices hu : IsUnit (u⁻¹ • 1 - a)
    · rwa [IsUnit.smul_sub_iff_sub_inv_smul, inv_inv u] at hu
    · rw [Units.smul_def, ← Algebra.algebraMap_eq_smul_one, ← mem_resolvent_set_iff]
      refine' mem_resolvent_set_of_spectral_radius_lt _
      rwa [Units.val_inv_eq_inv_val, nnnorm_inv,
        coe_inv (nnnorm_ne_zero_iff.mpr (Units.val_mk0 hz ▸ hz : (u : 𝕜) ≠ 0)), lt_inv_iff_lt_inv]
#align spectrum.is_unit_one_sub_smul_of_lt_inv_radius spectrum.isUnit_one_sub_smul_of_lt_inv_radius

/-- In a Banach algebra `A` over `𝕜`, for `a : A` the function `λ z, (1 - z • a)⁻¹` is
differentiable on any closed ball centered at zero of radius `r < (spectral_radius 𝕜 a)⁻¹`. -/
theorem differentiableOn_inverse_one_sub_smul [CompleteSpace A] {a : A} {r : ℝ≥0}
    (hr : (r : ℝ≥0∞) < (spectralRadius 𝕜 a)⁻¹) :
    DifferentiableOn 𝕜 (fun z : 𝕜 => Ring.inverse (1 - z • a)) (Metric.closedBall 0 r) :=
  by
  intro z z_mem
  apply DifferentiableAt.differentiableWithinAt
  have hu : IsUnit (1 - z • a) :=
    by
    refine' is_unit_one_sub_smul_of_lt_inv_radius (lt_of_le_of_lt (coe_mono _) hr)
    simpa only [norm_toNNReal, Real.toNNReal_coe] using
      Real.toNNReal_mono (mem_closed_ball_zero_iff.mp z_mem)
  have H₁ : Differentiable 𝕜 fun w : 𝕜 => 1 - w • a := (differentiable_id.smul_const a).const_sub 1
  exact DifferentiableAt.comp z (differentiableAt_inverse hu.unit) H₁.differentiable_at
#align spectrum.differentiable_on_inverse_one_sub_smul spectrum.differentiableOn_inverse_one_sub_smul

end OneSubSmul

section GelfandFormula

open Filter ENNReal ContinuousMultilinearMap

open Topology

variable [NormedRing A] [NormedAlgebra ℂ A] [CompleteSpace A]

/-- The `limsup` relationship for the spectral radius used to prove `spectrum.gelfand_formula`. -/
theorem limsup_pow_nnnorm_pow_one_div_le_spectralRadius (a : A) :
    limsup (fun n : ℕ => ↑‖a ^ n‖₊ ^ (1 / n : ℝ)) atTop ≤ spectralRadius ℂ a :=
  by
  refine' ennreal.inv_le_inv.mp (le_of_forall_pos_nnreal_lt fun r r_pos r_lt => _)
  simp_rw [inv_limsup, ← one_div]
  let p : FormalMultilinearSeries ℂ ℂ A := fun n =>
    ContinuousMultilinearMap.mkPiField ℂ (Fin n) (a ^ n)
  suffices h : (r : ℝ≥0∞) ≤ p.radius
  · convert h
    simp only [p.radius_eq_liminf, ← norm_toNNReal, norm_mk_pi_field]
    congr
    ext n
    rw [norm_toNNReal, ENNReal.coe_rpow_def ‖a ^ n‖₊ (1 / n : ℝ), if_neg]
    exact fun ha => by linarith [ha.2, (one_div_nonneg.mpr n.cast_nonneg : 0 ≤ (1 / n : ℝ))]
  · have H₁ := (differentiable_on_inverse_one_sub_smul r_lt).HasFpowerSeriesOnBall r_pos
    exact ((has_fpower_series_on_ball_inverse_one_sub_smul ℂ a).exchangeRadius H₁).r_le
#align spectrum.limsup_pow_nnnorm_pow_one_div_le_spectral_radius spectrum.limsup_pow_nnnorm_pow_one_div_le_spectralRadius

/-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the
`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/
theorem pow_nnnorm_pow_one_div_tendsto_nhds_spectralRadius (a : A) :
    Tendsto (fun n : ℕ => (‖a ^ n‖₊ ^ (1 / n : ℝ) : ℝ≥0∞)) atTop (𝓝 (spectralRadius ℂ a)) :=
  tendsto_of_le_liminf_of_limsup_le (spectralRadius_le_liminf_pow_nnnorm_pow_one_div ℂ a)
    (limsup_pow_nnnorm_pow_one_div_le_spectralRadius a)
#align spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectralRadius

/- This is the same as `pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius` but for `norm`
instead of `nnnorm`. -/
/-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the
`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/
theorem pow_norm_pow_one_div_tendsto_nhds_spectralRadius (a : A) :
    Tendsto (fun n : ℕ => ENNReal.ofReal (‖a ^ n‖ ^ (1 / n : ℝ))) atTop (𝓝 (spectralRadius ℂ a)) :=
  by
  convert pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius a
  ext1
  rw [← of_real_rpow_of_nonneg (norm_nonneg _) _, ← coe_nnnorm, coe_nnreal_eq]
  exact one_div_nonneg.mpr (by exact_mod_cast zero_le _)
#align spectrum.pow_norm_pow_one_div_tendsto_nhds_spectral_radius spectrum.pow_norm_pow_one_div_tendsto_nhds_spectralRadius

end GelfandFormula

section NonemptySpectrum

variable [NormedRing A] [NormedAlgebra ℂ A] [CompleteSpace A] [Nontrivial A] (a : A)

/-- In a (nontrivial) complex Banach algebra, every element has nonempty spectrum. -/
protected theorem nonempty : (spectrum ℂ a).Nonempty :=
  by
  /- Suppose `σ a = ∅`, then resolvent set is `ℂ`, any `(z • 1 - a)` is a unit, and `resolvent`
    is differentiable on `ℂ`. -/
  rw [Set.nonempty_iff_ne_empty]
  by_contra h
  have H₀ : resolventSet ℂ a = Set.univ := by rwa [spectrum, Set.compl_empty_iff] at h
  have H₁ : Differentiable ℂ fun z : ℂ => resolvent a z := fun z =>
    (has_deriv_at_resolvent (H₀.symm ▸ Set.mem_univ z : z ∈ resolventSet ℂ a)).DifferentiableAt
  /- The norm of the resolvent is small for all sufficently large `z`, and by compactness and
    continuity it is bounded on the complement of a large ball, thus uniformly bounded on `ℂ`.
    By Liouville's theorem `λ z, resolvent a z` is constant -/
  have H₂ := norm_resolvent_le_forall a
  have H₃ : ∀ z : ℂ, resolvent a z = resolvent a (0 : ℂ) :=
    by
    refine' fun z => H₁.apply_eq_apply_of_bounded (bounded_iff_forall_norm_le.mpr _) z 0
    rcases H₂ 1 zero_lt_one with ⟨R, R_pos, hR⟩
    rcases(ProperSpace.isCompact_closedBall (0 : ℂ) R).exists_bound_of_continuousOn
        H₁.continuous.continuous_on with
      ⟨C, hC⟩
    use max C 1
    rintro _ ⟨w, rfl⟩
    refine' Or.elim (em (‖w‖ ≤ R)) (fun hw => _) fun hw => _
    · exact (hC w (mem_closed_ball_zero_iff.mpr hw)).trans (le_max_left _ _)
    · exact (hR w (not_le.mp hw).le).trans (le_max_right _ _)
  -- `resolvent a 0 = 0`, which is a contradition because it isn't a unit.
  have H₅ : resolvent a (0 : ℂ) = 0 :=
    by
    refine' norm_eq_zero.mp (le_antisymm (le_of_forall_pos_le_add fun ε hε => _) (norm_nonneg _))
    rcases H₂ ε hε with ⟨R, R_pos, hR⟩
    simpa only [H₃ R] using
      (zero_add ε).symm.subst (hR R (by exact_mod_cast (Real.norm_of_nonneg R_pos.lt.le).symm.le))
  -- `not_is_unit_zero` is where we need `nontrivial A`, it is unavoidable.
  exact
    not_isUnit_zero
      (H₅.subst (is_unit_resolvent.mp (mem_resolvent_set_iff.mp (H₀.symm ▸ Set.mem_univ 0))))
#align spectrum.nonempty spectrum.nonempty

/-- In a complex Banach algebra, the spectral radius is always attained by some element of the
spectrum. -/
theorem exists_nnnorm_eq_spectralRadius : ∃ z ∈ spectrum ℂ a, (‖z‖₊ : ℝ≥0∞) = spectralRadius ℂ a :=
  exists_nnnorm_eq_spectralRadius_of_nonempty (spectrum.nonempty a)
#align spectrum.exists_nnnorm_eq_spectral_radius spectrum.exists_nnnorm_eq_spectralRadius

/-- In a complex Banach algebra, if every element of the spectrum has norm strictly less than
`r : ℝ≥0`, then the spectral radius is also strictly less than `r`. -/
theorem spectralRadius_lt_of_forall_lt {r : ℝ≥0} (hr : ∀ z ∈ spectrum ℂ a, ‖z‖₊ < r) :
    spectralRadius ℂ a < r :=
  spectralRadius_lt_of_forall_lt_of_nonempty (spectrum.nonempty a) hr
#align spectrum.spectral_radius_lt_of_forall_lt spectrum.spectralRadius_lt_of_forall_lt

open Polynomial

open Polynomial

/-- The **spectral mapping theorem** for polynomials in a Banach algebra over `ℂ`. -/
theorem map_polynomial_aeval (p : ℂ[X]) :
    spectrum ℂ (aeval a p) = (fun k => eval k p) '' spectrum ℂ a :=
  map_polynomial_aeval_of_nonempty a p (spectrum.nonempty a)
#align spectrum.map_polynomial_aeval spectrum.map_polynomial_aeval

/-- A specialization of the spectral mapping theorem for polynomials in a Banach algebra over `ℂ`
to monic monomials. -/
protected theorem map_pow (n : ℕ) : spectrum ℂ (a ^ n) = (fun x => x ^ n) '' spectrum ℂ a := by
  simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval a (X ^ n)
#align spectrum.map_pow spectrum.map_pow

end NonemptySpectrum

section GelfandMazurIsomorphism

variable [NormedRing A] [NormedAlgebra ℂ A] (hA : ∀ {a : A}, IsUnit a ↔ a ≠ 0)

include hA

-- mathport name: exprσ
local notation "σ" => spectrum ℂ

theorem algebraMap_eq_of_mem {a : A} {z : ℂ} (h : z ∈ σ a) : algebraMap ℂ A z = a := by
  rwa [mem_iff, hA, Classical.not_not, sub_eq_zero] at h
#align spectrum.algebra_map_eq_of_mem spectrum.algebraMap_eq_of_mem

/-- **Gelfand-Mazur theorem**: For a complex Banach division algebra, the natural `algebra_map ℂ A`
is an algebra isomorphism whose inverse is given by selecting the (unique) element of
`spectrum ℂ a`. In addition, `algebra_map_isometry` guarantees this map is an isometry.

Note: because `normed_division_ring` requires the field `norm_mul' : ∀ a b, ‖a * b‖ = ‖a‖ * ‖b‖`, we
don't use this type class and instead opt for a `normed_ring` in which the nonzero elements are
precisely the units. This allows for the application of this isomorphism in broader contexts, e.g.,
to the quotient of a complex Banach algebra by a maximal ideal. In the case when `A` is actually a
`normed_division_ring`, one may fill in the argument `hA` with the lemma `is_unit_iff_ne_zero`. -/
@[simps]
noncomputable def NormedRing.algEquivComplexOfComplete [CompleteSpace A] : ℂ ≃ₐ[ℂ] A :=
  let nt : Nontrivial A := ⟨⟨1, 0, hA.mp ⟨⟨1, 1, mul_one _, mul_one _⟩, rfl⟩⟩⟩
  { Algebra.ofId ℂ A with
    toFun := algebraMap ℂ A
    invFun := fun a => (@spectrum.nonempty _ _ _ _ nt a).some
    left_inv := fun z => by
      simpa only [@scalar_eq _ _ _ _ _ nt _] using
        (@spectrum.nonempty _ _ _ _ nt <| algebraMap ℂ A z).some_mem
    right_inv := fun a => algebraMap_eq_of_mem (@hA) (@spectrum.nonempty _ _ _ _ nt a).some_mem }
#align normed_ring.alg_equiv_complex_of_complete NormedRing.algEquivComplexOfComplete

end GelfandMazurIsomorphism

section ExpMapping

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

/-- For `𝕜 = ℝ` or `𝕜 = ℂ`, `exp 𝕜` maps the spectrum of `a` into the spectrum of `exp 𝕜 a`. -/
theorem exp_mem_exp [IsROrC 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A] [CompleteSpace A] (a : A) {z : 𝕜}
    (hz : z ∈ spectrum 𝕜 a) : exp 𝕜 z ∈ spectrum 𝕜 (exp 𝕜 a) :=
  by
  have hexpmul : exp 𝕜 a = exp 𝕜 (a - ↑ₐ z) * ↑ₐ (exp 𝕜 z) := by
    rw [algebraMap_exp_comm z, ← exp_add_of_commute (Algebra.commutes z (a - ↑ₐ z)).symm,
      sub_add_cancel]
  let b := ∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐ z) ^ n
  have hb : Summable fun n : ℕ => ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐ z) ^ n :=
    by
    refine' summable_of_norm_bounded_eventually _ (Real.summable_pow_div_factorial ‖a - ↑ₐ z‖) _
    filter_upwards [Filter.eventually_cofinite_ne 0]with n hn
    rw [norm_smul, mul_comm, norm_inv, IsROrC.norm_eq_abs, IsROrC.abs_cast_nat, ← div_eq_mul_inv]
    exact
      div_le_div (pow_nonneg (norm_nonneg _) n) (norm_pow_le' (a - ↑ₐ z) (zero_lt_iff.mpr hn))
        (by exact_mod_cast Nat.factorial_pos n)
        (by exact_mod_cast Nat.factorial_le (lt_add_one n).le)
  have h₀ : (∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐ z) ^ (n + 1)) = (a - ↑ₐ z) * b := by
    simpa only [mul_smul_comm, pow_succ] using hb.tsum_mul_left (a - ↑ₐ z)
  have h₁ : (∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐ z) ^ (n + 1)) = b * (a - ↑ₐ z) := by
    simpa only [pow_succ', Algebra.smul_mul_assoc] using hb.tsum_mul_right (a - ↑ₐ z)
  have h₃ : exp 𝕜 (a - ↑ₐ z) = 1 + (a - ↑ₐ z) * b :=
    by
    rw [exp_eq_tsum]
    convert tsum_eq_zero_add (exp_series_summable' (a - ↑ₐ z))
    simp only [Nat.factorial_zero, Nat.cast_one, inv_one, pow_zero, one_smul]
    exact h₀.symm
  rw [spectrum.mem_iff, IsUnit.sub_iff, ← one_mul (↑ₐ (exp 𝕜 z)), hexpmul, ← _root_.sub_mul,
    Commute.isUnit_mul_iff (Algebra.commutes (exp 𝕜 z) (exp 𝕜 (a - ↑ₐ z) - 1)).symm,
    sub_eq_iff_eq_add'.mpr h₃, Commute.isUnit_mul_iff (h₀ ▸ h₁ : (a - ↑ₐ z) * b = b * (a - ↑ₐ z))]
  exact not_and_of_not_left _ (not_and_of_not_left _ ((not_iff_not.mpr IsUnit.sub_iff).mp hz))
#align spectrum.exp_mem_exp spectrum.exp_mem_exp

end ExpMapping

end spectrum

namespace AlgHom

section NormedField

variable {F : Type _} [NormedField 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A] [CompleteSpace A]

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

/-- An algebra homomorphism into the base field, as a continuous linear map (since it is
automatically bounded). See note [lower instance priority] -/
instance (priority := 100) [AlgHomClass F 𝕜 A 𝕜] : ContinuousLinearMapClass F 𝕜 A 𝕜 :=
  { AlgHomClass.linearMapClass with
    map_continuous := fun φ =>
      AddMonoidHomClass.continuous_of_bound φ ‖(1 : A)‖ fun a =>
        mul_comm ‖a‖ ‖(1 : A)‖ ▸ spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum φ _) }

/-- An algebra homomorphism into the base field, as a continuous linear map (since it is
automatically bounded). -/
def toContinuousLinearMap (φ : A →ₐ[𝕜] 𝕜) : A →L[𝕜] 𝕜 :=
  { φ.toLinearMap with cont := map_continuous φ }
#align alg_hom.to_continuous_linear_map AlgHom.toContinuousLinearMap

@[simp]
theorem coe_toContinuousLinearMap (φ : A →ₐ[𝕜] 𝕜) : ⇑φ.toContinuousLinearMap = φ :=
  rfl
#align alg_hom.coe_to_continuous_linear_map AlgHom.coe_toContinuousLinearMap

theorem norm_apply_le_self_mul_norm_one [AlgHomClass F 𝕜 A 𝕜] (f : F) (a : A) :
    ‖f a‖ ≤ ‖a‖ * ‖(1 : A)‖ :=
  spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum f _)
#align alg_hom.norm_apply_le_self_mul_norm_one AlgHom.norm_apply_le_self_mul_norm_one

theorem norm_apply_le_self [NormOneClass A] [AlgHomClass F 𝕜 A 𝕜] (f : F) (a : A) : ‖f a‖ ≤ ‖a‖ :=
  spectrum.norm_le_norm_of_mem (apply_mem_spectrum f _)
#align alg_hom.norm_apply_le_self AlgHom.norm_apply_le_self

end NormedField

section NontriviallyNormedField

variable [NontriviallyNormedField 𝕜] [NormedRing A] [NormedAlgebra 𝕜 A] [CompleteSpace A]

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap 𝕜 A

@[simp]
theorem toContinuousLinearMap_norm [NormOneClass A] (φ : A →ₐ[𝕜] 𝕜) :
    ‖φ.toContinuousLinearMap‖ = 1 :=
  ContinuousLinearMap.op_norm_eq_of_bounds zero_le_one
    (fun a => (one_mul ‖a‖).symm ▸ spectrum.norm_le_norm_of_mem (apply_mem_spectrum φ _))
    fun _ _ h => by simpa only [coe_to_continuous_linear_map, map_one, norm_one, mul_one] using h 1
#align alg_hom.to_continuous_linear_map_norm AlgHom.toContinuousLinearMap_norm

end NontriviallyNormedField

end AlgHom

namespace WeakDual

namespace CharacterSpace

variable [NontriviallyNormedField 𝕜] [NormedRing A] [CompleteSpace A]

variable [NormedAlgebra 𝕜 A]

/-- The equivalence between characters and algebra homomorphisms into the base field. -/
def equivAlgHom : characterSpace 𝕜 A ≃ (A →ₐ[𝕜] 𝕜)
    where
  toFun := toAlgHom
  invFun f :=
    { val := f.toContinuousLinearMap
      property := by
        rw [eq_set_map_one_map_mul]
        exact ⟨map_one f, map_mul f⟩ }
  left_inv f := Subtype.ext <| ContinuousLinearMap.ext fun x => rfl
  right_inv f := AlgHom.ext fun x => rfl
#align weak_dual.character_space.equiv_alg_hom WeakDual.characterSpace.equivAlgHom

@[simp]
theorem equivAlgHom_coe (f : characterSpace 𝕜 A) : ⇑(equivAlgHom f) = f :=
  rfl
#align weak_dual.character_space.equiv_alg_hom_coe WeakDual.characterSpace.equivAlgHom_coe

@[simp]
theorem equivAlgHom_symm_coe (f : A →ₐ[𝕜] 𝕜) : ⇑(equivAlgHom.symm f) = f :=
  rfl
#align weak_dual.character_space.equiv_alg_hom_symm_coe WeakDual.characterSpace.equivAlgHom_symm_coe

end CharacterSpace

end WeakDual


-- ---------------------------------------------------------------------
-- Ejercicio. Ejercutar las siguientes acciones
-- 1. Importar la librería data.set.basic data.nat.parity
-- 2. Abrir los espacios de nombres set y nat.
-- ----------------------------------------------------------------------

import data.set.basic data.nat.parity

open set nat

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el conjunto de los números pares.
-- ----------------------------------------------------------------------

def evens : set ℕ := {n | even n}

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el conjunto de los números impares.
-- ----------------------------------------------------------------------

def odds :  set ℕ := {n | ¬ even n}

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar la unión de los pares e impares es el universal.
-- ----------------------------------------------------------------------

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

example : evens ∪ odds = univ :=
begin
  rw [evens, odds],
  ext n,
  simp,
  apply classical.em,
end

-- Prueba
-- ======

/-
⊢ evens ∪ odds = univ
  >> rw [evens, odds],
⊢ {n : ℕ | n.even} ∪ {n : ℕ | ¬n.even} = univ
  >> ext n,
n : ℕ
⊢ n ∈ {n : ℕ | n.even} ∪ {n : ℕ | ¬n.even} ↔ n ∈ univ
  >> simp,
⊢ n.even ∨ ¬n.even
  >> apply classical.em,
no goals
-/

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

example : evens ∪ odds = univ :=
begin
  ext n,
  simp,
  apply classical.em,
end

-- Prueba
-- ======

/-
⊢ evens ∪ odds = univ
  >> ext n,
n : ℕ
⊢ n ∈ evens ∪ odds ↔ n ∈ univ
  >> simp,
⊢ n ∈ evens ∨ n ∈ odds
  >> apply classical.em,
no goals
-/


--proving random stuff about fibonacci numbers
--hopefully show F_n | F_m if n | m
import tactic

--useful for working with Sigma notation
open_locale big_operators
open finset

def F : ℕ → ℤ
| 0 := 0
| 1 := 1
| (n + 2) := F n + F (n + 1)

lemma fib_nonneg' (n : ℕ) : ∀ m ≤ n, F m ≥ 0 :=
begin
  cases n,
  { intros,
    cases H,
    exact le_refl _,
  },
  induction n with n hn,
  { intros,
    cases H with H1 H2,
    { exact int.one_nonneg},
    { change m ≤ 0 at H2,
      rw nat.le_zero_iff at H2,
      rw H2,
      exact le_refl _,},
  },
  { intros,
    cases H with H1 H2,
    { change F n + F (n + 1) ≥ 0,
      apply add_nonneg,
      { apply hn,
        exact nat.le_succ n,
      },
      { apply hn,
        exact le_refl _,
      }
    },
    { exact hn m H2,}
  },
end
lemma fib_nonneg (n : ℕ) : F n ≥ 0 := fib_nonneg' n n (le_refl n)
lemma fib_add_two (n : ℕ) : F (n + 2) = F n + F (n + 1) := rfl
@[simp] lemma fib_zero : F 0 = 0 := rfl
@[simp] lemma fib_one : F 1 = 1 := rfl
@[simp] lemma fib_two : F 2 = 1 := rfl

example (n : ℕ) : ∑ i in range n, F i = F (n + 1) - 1 :=
begin
  induction n with n hn,
  { simp [F],},
  { rw sum_range_succ,
    rw hn,
    rw fib_add_two,
    ring,
  }
end

example (n : ℕ) : ∑ i in range (n + 1), (F i)^2 = F (n) * F (n+1) :=
begin
  induction n with n ih,
  { refl,},
  { rw sum_range_succ,
    rw ih,
    rw fib_add_two,
    ring,
  }
end

lemma fibonacci_hell' (m n : ℕ) : ∀ k : ℕ, k ≤ n → F (m + k + 1) =
  F (m + 1) * F (k + 1) + F m * F k :=
begin
  cases n,
  {simp,},
  induction n with n ih,
  { rintro ⟨k, rfl⟩,
    simp,
    intro h,
    cases h with h h,
    rw fib_add_two,
    simp,
    rw add_comm,
    cases h,
  },
  { intros k hk,
    cases hk with hk hk,
    { rw nat.add_succ m,
      rw fib_add_two,
      nth_rewrite 0 nat.add_succ,
      rw ih n (nat.le_succ n),
      rw ih (n.succ) (le_refl n.succ),
      rw fib_add_two n.succ,
      rw fib_add_two,
      ring,
    },
    { exact ih k hk},
  }
end

lemma fibonacci_hell (m n : ℕ) : F (m + n + 1) =
  F (m + 1) * F (n + 1) + F m * F n := fibonacci_hell' m n n (le_refl n)

lemma fib_dvd_fib (m n : ℕ) : n ∣ m → F n ∣ F m :=
begin
  rintro ⟨k, rfl⟩,
  cases n,
  { simp},
  induction k with k ih,
  { simp,},
  { have H : n.succ * k.succ = n.succ + n.succ*k := by {zify, ring},
    rw H,
    have H2 := fibonacci_hell n.succ (n.succ*k - 1),
    cases k,
    { simp,},
    have H3 : n.succ * k.succ - 1 + 1 = n.succ * k.succ,
      { apply nat.succ_pred_eq_of_pos,
        apply mul_pos;
        apply nat.succ_pos,
      },
    rw add_assoc at H2,
    rw H3 at H2,
    rw H2,
    apply dvd_add,
    { exact dvd_mul_of_dvd_right ih (F (nat.succ n + 1)),},
    { apply dvd_mul_right,},
  }
end


import tactic.norm_num
import tactic.linarith
import tactic.ring
import data.nat.basic
import data.real.basic
import data.set.basic
import data.set.lattice
import data.complex.basic
import data.complex.exponential
import data.polynomial
--import analysis.polynomial
--import analysis.exponential
import data.nat.choose

universe u
local attribute [instance, priority 0] classical.prop_decidable

--QUESTION 1

section question_1

open nat

----part a

------i

theorem count (n : ℕ) (hn : n ≥ 1) : finset.sum (finset.range (nat.succ n)) (λ m, choose n m) = 2 ^ n := ---ans
    begin
        have H := (add_pow (1 : ℕ) 1 n).symm,
        simpa [nat.one_pow, one_mul, one_add_one_eq_two,
            (finset.sum_nat_cast _ _).symm, nat.cast_id] using H,
    end

------ii
theorem countdown (n : ℕ) (hn : n ≥ 1) : finset.sum (finset.range (nat.succ n)) (λ m, (-1 : ℤ) ^ m * choose n m) = 0 := ---ans
    begin
        have H := (add_pow (-1 : ℤ) 1 n).symm,
        have H2 := @_root_.zero_pow ℤ _ _ hn,
        simpa [nat.one_pow, one_mul, one_add_one_eq_two, nat.zero_pow hn,
            (finset.sum_nat_cast _ _).symm, nat.cast_id, H2] using H,
    end

----part b
------i
open real
#exit
noncomputable def chebyshev : ℕ → polynomial ℝ
| 0 := polynomial.C 1
| 1 := polynomial.X
| (n + 2) := 2 * polynomial.X * chebyshev (n + 1) - chebyshev n

def chebyshev' : ℕ → polynomial ℤ
| 0 := polynomial.C 1
| 1 := polynomial.X
| (n + 2) := 2 * polynomial.X * chebyshev' (n + 1) - chebyshev' n

lemma polycos (n : ℕ) (hn : n ≥ 1) : ∀ θ : ℝ, cos (n * θ) = polynomial.eval (cos θ) (chebyshev n) :=
    begin
        intro θ,
        apply nat.strong_induction_on n,
        intros k ih,
        have ih1 : cos (↑(k - 1) * θ) = polynomial.eval (cos θ) (chebyshev (k - 1)),
            by_cases h : k = 0,
              simp [h, chebyshev],
          --by_cases h : k ≠ 0,
              exact ih (k - 1) (nat.sub_lt (nat.pos_of_ne_zero h) (by norm_num : 0 < 1)),
        have ih2 : cos (↑(k - 2) * θ) = polynomial.eval (cos θ) (chebyshev (k - 2)),
            by_cases h : k = 0,
              simp [h, chebyshev],
            --by_cases h : k ≠ 0,
              exact ih (k - 2) (nat.sub_lt (nat.pos_of_ne_zero h) (by norm_num : 0 < 2)),
        by_cases h1 : k = 0, simp [h1, chebyshev],
        by_cases h2 : k = 1, simp [h2, chebyshev],
        have hk : k = (k - 2) + 2, rw nat.sub_add_cancel, swap,
        rw [hk, chebyshev, ←hk, nat.succ_eq_add_one, (_ : k - 2 + 1 = k - 1), two_mul,
            polynomial.eval_sub, polynomial.eval_mul, polynomial.eval_add,
            polynomial.eval_X, ←two_mul, ←ih1, ←ih2],
        rw [←complex.of_real_inj, complex.of_real_sub, complex.of_real_mul, complex.of_real_mul,
            complex.of_real_cos, complex.of_real_cos, complex.of_real_cos, complex.of_real_cos,
            complex.cos, complex.cos, complex.cos, complex.cos],
        simp,
        rw [mul_div_cancel', ←mul_div_assoc, ←neg_div, ←add_div, add_mul, mul_add, mul_add,
            ←complex.exp_add, ←complex.exp_add, ←complex.exp_add, ←complex.exp_add,
            mul_assoc, mul_assoc, mul_assoc],
        rw [←one_mul (↑θ * complex.I)] {occs := occurrences.pos [5, 7]},
        rw [←add_mul, ←sub_eq_add_neg, ←sub_mul, ←neg_one_mul (↑θ * complex.I),
            ←add_mul, ←sub_eq_add_neg, ←sub_mul, @nat.cast_sub _ _ _ 1 k, add_sub, nat.cast_one,
            add_sub_cancel', ←sub_add, sub_add_eq_add_sub, one_add_one_eq_two, add_sub,
            ←sub_add_eq_add_sub, ←neg_add', one_add_one_eq_two, ←sub_add, sub_add_eq_add_sub,
            neg_add_self, zero_sub, nat.cast_sub, neg_mul_eq_neg_mul, neg_mul_eq_neg_mul,
            neg_sub, nat.cast_two, neg_add, sub_eq_neg_add, ←add_assoc, ←neg_add,
            ←sub_eq_neg_add, add_sub_add_right_eq_sub, ←add_assoc, sub_add_cancel],
        all_goals {
            try {
            have H : k ≥ 2,
                apply le_of_not_gt, intro,
                have h12 : k = 0 ∨ k = 1,
                    clear ih ih1 ih2 h1 h2, try { clear hk },
                    revert k a, exact dec_trivial,
                apply or.elim h12 (λ h12, h1 h12) (λ h12, h2 h12) },
                try { exact H }, try { exact le_trans (by norm_num : 1 ≤ 2) H } },
        apply two_ne_zero',
        apply @eq_of_add_eq_add_right _ _ _ 1 _,
        rw [add_assoc, one_add_one_eq_two, nat.sub_add_cancel H,
            nat.sub_add_cancel (le_trans (by norm_num : 1 ≤ 2) H)]
    end

theorem exist_polycos (n : ℕ) (hn : n ≥ 1) : ∃ Pn : polynomial ℝ, ∀ θ : ℝ, cos (n * θ) = polynomial.eval (cos θ) Pn := ---ans
    Exists.intro (chebyshev n) (polycos n hn)

------ii

open polynomial

example : chebyshev' 4 = 8 * X ^ 4 - 8 * X ^ 2 + 1 :=
begin
  unfold chebyshev',
  ring
end

------iii

lemma useful (k : ℕ) : polynomial.degree (chebyshev' k) = k :=
begin
    apply nat.strong_induction_on k,
    intros n ih,
    have ih1 : polynomial.degree (chebyshev' (n - 1)) = ↑(n - 1),
        by_cases h : n = 0,
            simp [h, chebyshev'], refl,
            exact ih _ (nat.sub_lt (nat.pos_of_ne_zero h) (zero_lt_one)),
    have ih2 : polynomial.degree (chebyshev' (n - 2)) = ↑(n - 2),
        by_cases h : n ≤ 1,
            apply or.elim ((dec_trivial : ∀ j : ℕ, j ≤ 1 → j = 0 ∨ j = 1) n h),
                intro h0, simp [h0, chebyshev'], refl,
                intro h1, simp [h1, chebyshev'], refl,
            apply ih _, apply nat.sub_lt (lt_of_not_ge (λ w, h (le_trans w zero_le_one))), norm_num,
    by_cases h : n ≥ 2,
        have H : n - 2 + 2 = n := nat.sub_add_cancel h,
        have H' : nat.succ (n - 2) = n - 1,
            have W : n ≥ 2,
                apply le_of_not_gt, intro,
                have h12 : n = 0 ∨ n = 1,
                    clear ih ih1 ih2 H h,
                    revert n a, exact dec_trivial,
                apply or.elim h12,
                    intro h1, rw h1 at h, revert h, norm_num,
                    intro h2, rw h2 at h, revert h, norm_num,
        apply @eq_of_add_eq_add_right _ _ _ 1 _,
        show n - 2 + 1 + 1 = n - 1 + 1,
        rw [add_assoc, one_add_one_eq_two, nat.sub_add_cancel W,
            nat.sub_add_cancel (le_of_lt h)],
        rw [←H, chebyshev', H, sub_eq_neg_add, polynomial.degree_add_eq_of_degree_lt,
            polynomial.degree_mul_eq, polynomial.degree_mul_eq, polynomial.degree_X, H', ih1],
        show (polynomial.degree (polynomial.C 2) + 1 + ↑(n - 1) = ↑n),
        rw [polynomial.degree_C, zero_add, ←with_bot.coe_one, ←with_bot.coe_add,
            add_comm, nat.sub_add_cancel (le_of_lt h)],
        exact two_ne_zero',
        rw [polynomial.degree_neg, polynomial.degree_mul_eq, polynomial.degree_mul_eq, ih2, H', ih1],
        show (↑(n - 2) < polynomial.degree (polynomial.C 2) + polynomial.degree polynomial.X + ↑(n - 1)),
        rw [polynomial.degree_C, polynomial.degree_X, zero_add, ←with_bot.coe_one, ←with_bot.coe_add,
            add_comm, nat.sub_add_cancel (le_of_lt h), with_bot.coe_lt_coe],
        apply nat.sub_lt (lt_trans zero_lt_one h), norm_num,
        exact two_ne_zero',
        apply or.elim ((dec_trivial : ∀ j : ℕ, j ≤ 1 → j = 0 ∨ j = 1) n (le_of_not_gt h)),
            intro h0, simp [h0, chebyshev'], refl,
            intro h1, simp [h1, chebyshev']
end

lemma useful' (k : ℕ) : polynomial.degree (chebyshev' (k - 2)) < 1 + polynomial.degree (chebyshev' (k - 1)) :=
begin
    rw [useful, useful, ←with_bot.coe_one, ←with_bot.coe_add, with_bot.coe_lt_coe, add_comm],
    by_cases h : k ≤ 1,
        apply or.elim ((dec_trivial : ∀ (j : ℕ), j ≤ 1 → j = 0 ∨ j = 1) k h),
            intro h0, simp [h0], exact zero_lt_one,
            intro h1, simp [h1], exact zero_lt_one,
    rw [nat.sub_add_cancel (le_of_not_le h)],
    apply nat.sub_lt (lt_of_lt_of_le zero_lt_one (le_of_not_le h)), norm_num
end

theorem not_useful (n : ℕ) : polynomial.leading_coeff (chebyshev' n) = 2 ^ (n - 1) := ---ans
begin
    apply nat.strong_induction_on n, intros k hk,
    have h1 : polynomial.leading_coeff (chebyshev' (k - 1)) = 2 ^ (k - 1 - 1),
        by_cases h : k = 0,
          simp [h, chebyshev'],
          exact hk (k - 1) (nat.pred_lt h : k - 1 < k),
    have h2 : polynomial.leading_coeff (chebyshev' (k - 2)) = 2 ^ (k - 2 - 1),
        by_cases h : k ≤ 1,
            apply or.elim ((dec_trivial : ∀ j : ℕ, j ≤ 1 → j = 0 ∨ j = 1) k h),
                intro h0, simp [h0, chebyshev'],
                intro h1, simp [h1, chebyshev'],
            exact hk (k - 2) (nat.sub_lt (lt_of_not_ge (λ w, h (le_trans w zero_le_one))) (by norm_num)),
    by_cases h : k ≥ 2,
        have H : k - 2 + 2 = k := nat.sub_add_cancel h,
        rw [←H, chebyshev', H, (_ : nat.succ (k - 2) = k - 1), sub_eq_add_neg, add_comm,
            polynomial.leading_coeff_add_of_degree_lt, polynomial.leading_coeff_mul,
            polynomial.leading_coeff_mul, ←one_add_one_eq_two,
            polynomial.leading_coeff_add_of_degree_eq rfl, ←polynomial.C_1,
            polynomial.leading_coeff_C, polynomial.leading_coeff_X, h1,
            one_add_one_eq_two, mul_one, ←pow_succ, nat.sub_add_cancel],
    change 1 ≤ k - 1,
    rwa [nat.le_sub_left_iff_add_le (le_of_lt h), one_add_one_eq_two],
    rw [←polynomial.C_1, polynomial.leading_coeff_C, one_add_one_eq_two], exact two_ne_zero',
    rw [polynomial.degree_neg, polynomial.degree_mul_eq, polynomial.degree_mul_eq,
        ((one_add_one_eq_two).symm : ((2 : polynomial ℤ) = 1 + 1)), ←polynomial.C_1, ←polynomial.C_add,
        one_add_one_eq_two, polynomial.degree_C, zero_add, polynomial.degree_X],
    exact useful' k,
    exact two_ne_zero',
    rw [nat.succ_eq_add_one, eq_comm, ←nat.sub_eq_iff_eq_add, nat.sub_sub, one_add_one_eq_two],
    rwa [nat.le_sub_left_iff_add_le (le_of_lt h), one_add_one_eq_two],
    rw not_lt at h,
    have h' : k = 0 ∨ k = 1, clear hk h1 h2, revert k h, exact dec_trivial,
    cases h',
        all_goals { simp [h', chebyshev'] }
end

------iv

theorem cheby1 (n : ℕ) (hn : n ≥ 1) : polynomial.eval 1 (chebyshev n) = 1 := ---ans
begin
    have h := (polycos n hn 0).symm,
    rwa [mul_zero, cos_zero] at h,
end

--QUESTION 2
----part a
------i
def ub (S : set ℝ) (x : ℝ) := ∀ s ∈ S, s ≤ x ---ans

------ii
def iba (S : set ℝ) := ∃ x, ub S x ---ans

------iii
def lub (S : set ℝ) (x : ℝ) := ub S x ∧ ∀ y : ℝ, (ub S y → x ≤ y) ---ans

----part b
theorem lub_duh (S : set ℝ) : (∃ x, lub S x) → S ≠ ∅ ∧ iba S := ---ans
    begin
        intro Hexlub, cases Hexlub with x Hlub,
        split,
            intro Hemp, rw set.empty_def at Hemp,
            cases Hlub with Hub Hl,
            have Hallub : ∀ y : ℝ, ub S y,
                unfold ub, rw Hemp, change (∀ (y s : ℝ), false → s ≤ y),
                intros y s Hf, exfalso, exact Hf,
            have Hneginf : ∀ y : ℝ, x ≤ y,
                intro y, apply Hl, apply Hallub,
            have Hcontr := Hneginf (x - 1),
            revert Hcontr, norm_num,
      --split,
            existsi x, exact Hlub.left,
    end

----part c
------i
def S1 := {x : ℝ | x < 59}

lemma between_bounds (x y : ℝ) (H : x < y) : x < (x + y) / 2 ∧ (x + y) / 2 < y :=
⟨by linarith, by linarith⟩

theorem S1_lub : ∃ x, lub S1 x := ---ans
    begin
        existsi (59 : ℝ),
        split,
            intro, change (s < 59 → s ≤ 59), exact le_of_lt,
      --split,
            intro y, change ((∀ (s : ℝ), s < 59 → s ≤ y) → 59 ≤ y), intro Hbub,
            apply le_of_not_gt, intro Hbadub,
            have Houtofbounds := between_bounds y 59 Hbadub,
            apply not_le_of_gt Houtofbounds.1 (Hbub ((y + 59) / 2) Houtofbounds.2),
    end

------ii

/------------------SORRY--------------------/

----part d
------i
theorem ublub_the_first (S : set ℝ) (b : ℝ) (hub : ub S b) (hin : b ∈ S) : lub S b := ---ans
    begin
        split,
            exact hub,
      --split,
            intros y huby,
            exact huby b hin,
    end

------ii
theorem adlub_the_second (S T : set ℝ) (b c : ℝ) (hlubb : lub S b) (hlubc : lub T c) ---ans
: lub ({x : ℝ | ∃ s t : ℝ, s ∈ S ∧ t ∈ T ∧ x = s + t}) (b + c) :=
    begin
        split,
            unfold ub, simp, intros x s hss t htt hxst, rw hxst,
            apply add_le_add (hlubb.1 s hss) (hlubc.1 t htt),
      --split,
            unfold ub, simp, intros x Hx,
            apply le_of_not_gt, intro Hcontr,
            let ε := b + c - x,
            have Hcontr' : ε > 0 := (by linarith : b + c - x > 0),
            have rwx : x = (b - ε / 2) + (c - ε / 2)
            := (by linarith : x = (b - (b + c - x) / 2) + (c - (b + c - x) / 2)),
            have hnbub : ∃ s' ∈ S, b - ε / 2 < s',
                by_contradiction,
                have a' : (¬∃ (s' : ℝ), s' ∈ S ∧ b - ε / 2 < s'),
                    intro b, apply a, cases b with σ Hσ, existsi σ, existsi Hσ.1, exact Hσ.2,
                have a'' : ∀ (x : ℝ), x ∈ S → ¬(b - ε / 2 < x),
                    intros x Hx Hb, rw not_exists at a', apply a' x, exact ⟨Hx, Hb⟩,
                simp only [not_lt] at a'', rw ←ub at a'',
                have a''' := hlubb.2 _ a'',
                linarith,
            have hnbuc : ∃ t' ∈ T, c - ε / 2 < t',
                by_contradiction,
                have a' : (¬∃ (t' : ℝ), t' ∈ T ∧ c - ε / 2 < t'),
                    intro b, apply a, cases b with σ Hσ, existsi σ, existsi Hσ.1, exact Hσ.2,
                have a'' : ∀ (x : ℝ), x ∈ T → ¬(c - ε / 2 < x),
                    intros x Hx Hc, rw not_exists at a', apply a' x, exact ⟨Hx, Hc⟩,
                simp only [not_lt] at a'', rw ←ub at a'',
                have a''' := hlubc.2 _ a'',
                linarith,
            cases hnbub with s' hnbub', cases hnbub' with Hs' hnbub'',
            cases hnbuc with t' hnbuc', cases hnbuc' with Ht' hnbuc'',
            have Hx' := Hx (s' + t') s' Hs' t' Ht' rfl,
            have Haha : x < x
            := lt_of_lt_of_le (by { rw rwx, apply add_lt_add hnbub'' hnbuc'' } : x < s' + t') Hx',
            linarith,
    end

--QUESTION 3
variable {S : Type u}

----part a
------i
variable (binary_relation : S → S → Prop) ---ans
local infix ` ~ `:1000 := binary_relation

------ii
def reflexivity := ∀ x, x ~ x
def symmetry := ∀ (x y), x ~ y → y ~ x
def transitivity := ∀ (x y z), x ~ y → y ~ z → x ~ z
def is_equivalence := reflexivity binary_relation ∧ symmetry binary_relation ∧ transitivity binary_relation ---ans

------iii
variable {binary_relation}
def cl (h : is_equivalence binary_relation) (a : S) : set S := { x | x ~ a } ---ans

----part b
theorem classes_injective2 (h : is_equivalence binary_relation) (a b : S) : (cl h a = cl h b) ∨ (cl h a ∩ cl h b) = ∅ := ---ans
    begin
        /-duplicate h so we can continue using it as a parameter to cl, then unpack hDupe-/
        have hDupe : is_equivalence binary_relation := h,
        cases hDupe with hR hST, cases hST with hS hT,
        rw reflexivity at hR, rw symmetry at hS, rw transitivity at hT,
        /-if one of them is true (if they exclude) we don't need to bother-/
        cases classical.em (cl h a ∩ cl h b = ∅) with excl intsct,
        --case excl
            right, exact excl,
        --case intsct
            left,
            /-prove that if something isn't empty it must have stuff in it-/
            rw set.eq_empty_iff_forall_not_mem at intsct,
            rw not_forall_not at intsct,
            /-clean stuff up-/
            cases intsct with x intsctX, cases intsctX with intsctXa intsctXb,
            rw cl at intsctXa, rw cl at intsctXb,
            change binary_relation x a at intsctXa, change binary_relation x b at intsctXb,
            rename intsctXa Hrxa, rename intsctXb Hrxb,
            rw cl, rw cl,
            /-now do the actual math-/
            have Hrax : binary_relation a x, apply hS x a, exact Hrxa,
            have Hrab : binary_relation a b, apply hT a x b, exact Hrax, exact Hrxb,
            have Hrba : binary_relation b a, apply hS a b, exact Hrab,
            /-definition of set equivalence-/
            apply set.eq_of_subset_of_subset,
            --split 1
                /-clean things up again-/
                intro y, intro Hrya, change binary_relation y a at Hrya, change binary_relation y b,
                /-do math again-/
                apply hT y a b, exact Hrya, exact Hrab,
            --split 2
                /-clean things up again-/
                intro y, intro Hryb, change binary_relation y b at Hryb, change binary_relation y a,
                /-do math again-/
                have Hrby : binary_relation b y, apply hS y b, exact Hryb,
                apply hT y b a, exact Hryb, exact Hrba,
    end

----part c

inductive double_cosets : ℤ → ℤ → Prop
    | cond1 : ∀ x, double_cosets x (x + 3)
    | cond2 : ∀ x, double_cosets x (x - 5)
    | condT : ∀ x y z, double_cosets x y → double_cosets y z → double_cosets x z
local infix ` ⋆ `:1001 := double_cosets

theorem double_cosets_reflexive : reflexivity double_cosets := ---ans
    begin
        rw reflexivity, intro x,
        /-get some trivial things out of the way-/
        have H0 : x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3 = x, norm_num,
        /-start moving-/
        have Hx5x : x ⋆ (x - 5), exact double_cosets.cond2 x,
        have H5x10x : (x - 5) ⋆ (x - 5 - 5), exact double_cosets.cond2 (x - 5),
        have H10x15x : (x - 5 - 5) ⋆ (x - 5 - 5 - 5), exact double_cosets.cond2 (x - 5 - 5),
        /-transitivity is hopper fare-/
        have Hx10x : x ⋆ (x - 5 - 5), apply double_cosets.condT x (x - 5) (x - 5 - 5), exact Hx5x, exact H5x10x,
        have Hx15x : x ⋆ (x - 5 - 5 - 5), apply double_cosets.condT x (x - 5 - 5) (x - 5 - 5 - 5), exact Hx10x, exact H10x15x,
        /-now come back-/
        have H15x12x : (x - 5 - 5 - 5) ⋆ (x - 5 - 5 - 5 + 3), exact double_cosets.cond1 (x - 5 - 5 - 5),
        have H12x9x : (x - 5 - 5 - 5 + 3) ⋆ (x - 5 - 5 - 5 + 3 + 3), exact double_cosets.cond1 (x - 5 - 5 - 5 + 3),
        have H9x6x : (x - 5 - 5 - 5 + 3 + 3) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3), exact double_cosets.cond1 (x - 5 - 5 - 5 + 3 + 3),
        have H6x3x : (x - 5 - 5 - 5 + 3 + 3 + 3) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3 + 3), exact double_cosets.cond1 (x - 5 - 5 - 5 + 3 + 3 + 3),
        have H3xx : (x - 5 - 5 - 5 + 3 + 3 + 3 + 3) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3), exact double_cosets.cond1 (x - 5 - 5 - 5 + 3 + 3 + 3 + 3),
        /-are we still within 1 hour?-/
        have H15x9x : (x - 5 - 5 - 5) ⋆ (x - 5 - 5 - 5 + 3 + 3), apply double_cosets.condT (x - 5 - 5 - 5) (x - 5 - 5 - 5 + 3) (x - 5 - 5 - 5 + 3 + 3), exact H15x12x, exact H12x9x,
        have H15x6x : (x - 5 - 5 - 5) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3), apply double_cosets.condT (x - 5 - 5 - 5) (x - 5 - 5 - 5 + 3 + 3) (x - 5 - 5 - 5 + 3 + 3 + 3), exact H15x9x, exact H9x6x,
        have H15x3x : (x - 5 - 5 - 5) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3 + 3), apply double_cosets.condT (x - 5 - 5 - 5) (x - 5 - 5 - 5 + 3 + 3 + 3) (x - 5 - 5 - 5 + 3 + 3 + 3 + 3), exact H15x6x, exact H6x3x,
        have H15xx : (x - 5 - 5 - 5) ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3), apply double_cosets.condT (x - 5 - 5 - 5) (x - 5 - 5 - 5 + 3 + 3 + 3 + 3) (x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3), exact H15x3x, exact H3xx,
        have Hxx : x ⋆ (x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3), apply double_cosets.condT x (x - 5 - 5 - 5) (x - 5 - 5 - 5 + 3 + 3 + 3 + 3 + 3), exact Hx15x, exact H15xx,
        /-show that we're back-/
        rw H0 at Hxx, exact Hxx,
    end

----part d

def S' : Type := fin 2

inductive self : fin 2 → fin 2 → Prop
    | condR : ∀ x, self x x
local infix ` ⋆ `:1 := self

theorem self_transitive : transitivity self := ---ans
    begin
        rw transitivity,
        intros x y z,
        --rw S' at z y x,
        have Hxyyzzx : x = y ∨ y = z ∨ z = x,
            cases classical.em (x = y ∨ y = z ∨ z = x) with corr contr,
            --case corr
                exact corr,
            --case contr
                exfalso,
                have contr_rw : ¬ (x = y) ∧ ¬ (y = z) ∧ ¬ (z = x),
                    rw ←not_or_distrib, rw ←not_or_distrib, exact contr,
                cases contr_rw with contr_xy contr_yzzx, cases contr_yzzx with contr_yz contr_zx,
                have H01 : ∀ s : fin 2, s = 0 ∨ s = 1, exact dec_trivial,
                have x01 : x = 0 ∨ x = 1, exact H01 x,
                have y01 : y = 0 ∨ y = 1, exact H01 y,
                have z01 : z = 0 ∨ z = 1, exact H01 z,
                cases x01, cases y01, cases z01,
                    rw ←y01 at x01, apply contr_xy, exact x01,
                    rw ←y01 at x01, apply contr_xy, exact x01,
                  cases z01,
                    rw ←x01 at z01, apply contr_zx, exact z01,
                    rw ←z01 at y01, apply contr_yz, exact y01,
                  cases y01, cases z01,
                    rw ←z01 at y01, apply contr_yz, exact y01,
                    rw ←x01 at z01, apply contr_zx, exact z01,
                  cases z01,
                    rw ←y01 at x01, apply contr_xy, exact x01,
                    rw ←y01 at x01, apply contr_xy, exact x01,
        cases Hxyyzzx with Hxy Hyzzx,
        --case Hxy
            rw Hxy,
            intro Hyy, intro Hyz, exact Hyz,
          cases Hyzzx with Hyz Hxy,
        --case Hyz
            rw Hyz,
            intro Hxz, intro Hzz, exact Hxz,
        --case Hxy
            rw Hxy,
            intro Hxy, intro Hyx, exact self.condR x,
    end

--QUESTION 4
variable {X : Type u}
variable {Y : Type u}
variable {f : X → Y}

----part a
------i
def injectivity (g : X → Y) := ∀ x1 x2 : X, g x1 = g x2 → x1 = x2 ---ans

------ii
def surjectivity (g : X → Y) := ∀ y : Y, ∃ x : X, g x = y ---ans

------iii
def bijectivity (g : X → Y) := injectivity g ∧ surjectivity g ---ans

----part b
------i
def f1 : ℕ → ℕ
    | n := n + 2
theorem injection : ∃ f : ℕ → ℕ, injectivity f ∧ ¬ surjectivity f := ---ans
    begin
        have injectionf1 : injectivity f1 ∧ ¬ surjectivity f1,
            split,
            --split 1
                rw injectivity,
                change ∀ (x1 x2 : ℕ), x1 + 2 = x2 + 2 → x1 = x2,
                intros x1 x2, intro Hinjsame,
                calc x1 = x1 + 2 - 2 : by rw nat.add_sub_cancel
                    ... = x2 + 2 - 2 : by rw Hinjsame
                    ... = x2 : by rw nat.add_sub_cancel,
            --split 2
                rw surjectivity, intro Hsurj,
                change ∀ (y : ℕ), ∃ (x : ℕ), x + 2 = y at Hsurj,
                have Hsurj1 := Hsurj 1,
                cases Hsurj1 with x Hx10',
                have Hx10 : x + 1 = 0 :=
                    calc x + 1 = x + (2 - 1) : by norm_num
                           ... = (x + 2) - 1 : begin rw ←nat.add_sub_assoc, norm_num end
                           ... = 1 - 1 : by rw Hx10'
                           ... = 0 : by rw nat.sub_self,
                have Hnx10 : x + 1 ≠ 0, exact nat.add_one_ne_zero x,
                apply Hnx10, exact Hx10,
        fapply exists.intro, exact f1, exact injectionf1,
    end

------ii
def f2 : ℕ → ℕ
    | n := n / 2

theorem surjection : ∃ f : ℕ → ℕ, surjectivity f ∧ ¬ injectivity f := ---ans
    begin
        have surjectionf2 : surjectivity f2 ∧ ¬ injectivity f2,
            split,
            --split 1
                rw surjectivity,
                change ∀ (y : ℕ), ∃ (x : ℕ), x / 2 = y,
                intro y,
                fapply exists.intro, exact 2 * y,
                    calc 2 * y / 2 = (2 * y + 0) / 2 : by rw nat.add_zero
                               ... = (0 + 2 * y) / 2 : by rw nat.add_comm
                               ... = 0 / 2 + y : begin rw nat.add_mul_div_left 0 y, norm_num, end
                               ... = 0 + y : by norm_num
                               ... = y + 0 : by rw nat.add_comm
                               ... = y : by rw nat.add_zero,
            --split 2
                rw injectivity, intro Hinj,
                change ∀ (x1 x2 : ℕ), x1 / 2 = x2 / 2 → x1 = x2 at Hinj,
                have Hinjsame23 := Hinj 2 3,
                have Hn23 : 2 = 3 → false, norm_num,
                apply Hn23, apply Hinjsame23, norm_num,
        fapply exists.intro, exact f2, exact surjectionf2,
    end

------iii
theorem bijections_are_injections : (∃ f : ℕ → ℕ, bijectivity f ∧ ¬ injectivity f) → false := ---ans
    begin
        intro Hf,
        cases Hf with f Hff,
        rw bijectivity at Hff,
        cases Hff with Hffis Hfffi, cases Hffis with Hffi Hffs,
        apply Hfffi, exact Hffi,
    end

------iv
def setN : set ℕ := set.univ
def powN := set.powerset setN

theorem cantor : ¬ (∃ F : ℕ → set ℕ, bijectivity F) := ---ans
    begin
        intro HE_cantor,
        cases HE_cantor with F HE_cantor_F,
        let Snm : set ℕ := {n : ℕ | ¬ (n ∈ F n)},
        rw bijectivity at HE_cantor_F, cases HE_cantor_F with HE_can_F HE_tor_F, rw surjectivity at HE_tor_F, rw injectivity at HE_can_F,
        have HE_tor_F_S := HE_tor_F Snm,
        cases HE_tor_F_S with x Hx_tor_F_S,
        cases classical.em (x ∈ Snm) with HxS HxnS,
        --case HxS
            have HnxS := HxS,
            change ¬ (x ∈ F x) at HnxS,
            rw Hx_tor_F_S at HnxS,
            apply HnxS, exact HxS,
        --case HxnS
            have HyxS := HxnS,
            change ¬ ¬ (x ∈ F x) at HyxS,
            rw Hx_tor_F_S at HyxS,
            apply HyxS, exact HxnS,
    end

----part c
def G (f : X → Y) : set (X × Y) := { g | g.2 = f (g.1) }
def p1 (g : G f) : X := g.1.1

def injectivity' {X' Y' : Type u} (g : X' → Y') := ∀ x1 x2 : X', g x1 = g x2 → x1 = x2
def surjectivity' {X' Y' : Type u} (g : X' → Y') := ∀ y : Y', ∃ x : X', g x = y
def bijectivity' {X' Y' : Type u} (g : X' → Y') := injectivity' g ∧ surjectivity' g

theorem bij_p1 : @bijectivity' (↥(G f)) X (p1) := ---ans
    begin
        split,
            intros x1 x2 Hpx, rw [p1, p1] at Hpx,
            cases x1, cases x2, cases x1_val, cases x2_val,
            change x1_val_snd = f(x1_val_fst) at x1_property,
            change x2_val_snd = f(x2_val_fst) at x2_property,
            simp, simp at Hpx,
            have Hpfx : x1_val_snd = x2_val_snd, rw [x1_property, x2_property, Hpx],
            split, rw Hpx, rw Hpfx,
      --split,
            intro x,
            let xy : (↥(G f)) := ⟨⟨x,f x⟩, rfl⟩,
            existsi xy, refl,
    end

----part d
def p2 (g : G f) : Y := g.1.2

theorem bij_p2_f : @bijectivity' (↥(G f)) Y (p2) → bijectivity' f := ---ans
    begin
        intro Hp,
        cases Hp with Hpi Hps, rw injectivity' at Hpi, rw surjectivity' at Hps,
        split,
            intros a b Hfx,
            let afa : (↥(G f)) := ⟨⟨a,f a⟩, rfl⟩,
            let bfb : (↥(G f)) := ⟨⟨b,f b⟩, rfl⟩,
            have Hpab : p2 afa = p2 bfb, rw [p2, p2], simp, exact Hfx,
            have Hpiab := Hpi afa bfb Hpab, simp at Hpiab, cases Hpiab with Hab Hfab,
            exact Hab,
      --split,
            intro y,
            have Hpsy := Hps y, cases Hpsy with xy Hpxy,
            rw p2 at Hpxy, cases xy, cases xy_val, change xy_val_snd = y at Hpxy,
            change xy_val_snd = f xy_val_fst at xy_property,
            existsi xy_val_fst, rw [←xy_property, Hpxy],
    end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import data.matrix.basic
import linear_algebra.finite_dimensional

/-!
# The finite-dimensional space of matrices

This file shows that `m` by `n` matrices form a finite-dimensional space,
and proves the `finrank` of that space is equal to `card m * card n`.

## Main definitions

 * `matrix.finite_dimensional`: matrices form a finite dimensional vector space over a field `K`
 * `matrix.finrank_matrix`: the `finrank` of `matrix m n R` is `card m * card n`

## Tags

matrix, finite dimensional, findim, finrank

-/

universes u v

namespace matrix

section finite_dimensional

variables {m n : Type*} [fintype m] [fintype n]
variables {R : Type v} [field R]

instance : finite_dimensional R (matrix m n R) :=
linear_equiv.finite_dimensional (linear_equiv.curry R m n)

/--
The dimension of the space of finite dimensional matrices
is the product of the number of rows and columns.
-/
@[simp] lemma finrank_matrix :
  finite_dimensional.finrank R (matrix m n R) = fintype.card m * fintype.card n :=
by rw [@linear_equiv.finrank_eq R (matrix m n R) _ _ _ _ _ _ (linear_equiv.curry R m n).symm,
       finite_dimensional.finrank_fintype_fun_eq_card, fintype.card_prod]

end finite_dimensional

end matrix


import tactic -- hide
open function nat -- hide

/-
## The `intro` tactic

Many statements in mathematics start with the phrase: "for all $x$ such that...". The way to proceed is usually
to suppose that we are given an $x$ with the given condition, and then prove something about it.

The tactic `intro` allows for this. It takes a parameter, which will be the name given to the variable.

It also works in statements of the form `P → Q` (we can think of it as equivalent to "To each proof of $P$ we produce a proof of $Q$").

In the following lemma, we will need to apply the `intro` tactic twice to get to business.

**Pro tip:** the `revert` tactic does exactly the opposite.

**Pro tip bis:** `intros h1 h2 h3,` is the same as `intro h1, intro h2, intro h3,`.
-/
/- Symbol:
∀ : \forall
→ : \imp
-/
/- Lemma : no-side-bar
For all $a$, if $a = 3$ then $a + 1 = 4$.
-/
lemma l4 : ∀ (a : ℕ),  a = 3 → a + 1 = 4 :=
begin
  intro a,
  intro h,
  rw h,

end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Eric Wieser
-/

import algebra.char_p.basic
import ring_theory.ideal.quotient

/-!
# Characteristic of quotients rings
-/

universes u v

namespace char_p

theorem quotient (R : Type u) [comm_ring R] (p : ℕ) [hp1 : fact p.prime] (hp2 : ↑p ∈ nonunits R) :
  char_p (R ⧸ (ideal.span {p} : ideal R)) p :=
have hp0 : (p : R ⧸ (ideal.span {p} : ideal R)) = 0,
  from map_nat_cast (ideal.quotient.mk (ideal.span {p} : ideal R)) p ▸
    ideal.quotient.eq_zero_iff_mem.2 (ideal.subset_span $ set.mem_singleton _),
ring_char.of_eq $ or.resolve_left ((nat.dvd_prime hp1.1).1 $ ring_char.dvd hp0) $ λ h1,
hp2 $ is_unit_iff_dvd_one.2 $ ideal.mem_span_singleton.1 $ ideal.quotient.eq_zero_iff_mem.1 $
@@subsingleton.elim (@@char_p.subsingleton _ $ ring_char.of_eq h1) _ _

/-- If an ideal does not contain any coercions of natural numbers other than zero, then its quotient
inherits the characteristic of the underlying ring. -/
lemma quotient' {R : Type*} [comm_ring R] (p : ℕ) [char_p R p] (I : ideal R)
  (h : ∀ x : ℕ, (x : R) ∈ I → (x : R) = 0) :
  char_p (R ⧸ I) p :=
⟨λ x, begin
  rw [←cast_eq_zero_iff R p x, ←map_nat_cast (ideal.quotient.mk I)],
  refine quotient.eq'.trans (_ : ↑x - 0 ∈ I ↔ _),
  rw sub_zero,
  exact ⟨h x, λ h', h'.symm ▸ I.zero_mem⟩,
end⟩

end char_p


-- ---------------------------------------------------------------------
-- Ejercicio. Sean m y n números naturales. Demostrar que si
--    m ∣ n ∧ m ≠ n
-- entonces
--    m ∣ n ∧ ¬ n ∣ m
-- ----------------------------------------------------------------------

import data.nat.gcd

open nat

variables {m n : ℕ}

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

example
  (h : m ∣ n ∧ m ≠ n)
  : m ∣ n ∧ ¬ n ∣ m :=
begin
  cases h with h₀ h₁,
  split,
    exact h₀,
  contrapose! h₁,
  apply dvd_antisymm h₀ h₁,
end

-- Prueba
-- ======

/-
m n : ℕ,
h : m ∣ n ∧ m ≠ n
⊢ m ∣ n ∧ ¬n ∣ m
  >> cases h with h₀ h₁,
h₀ : m ∣ n,
h₁ : m ≠ n
⊢ m ∣ n ∧ ¬n ∣ m
  >> split,
| ⊢ m ∣ n
|   >>   exact h₀,
⊢ ¬n ∣ m
  >> contrapose! h₁,
h₁ : n ∣ m
⊢ m = n
  >> apply dvd_antisymm h₀ h₁,
no goals
-/

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

example
  (h : m ∣ n ∧ m ≠ n)
  : m ∣ n ∧ ¬ n ∣ m :=
begin
  rcases h with ⟨h₀, h₁⟩,
  split,
    exact h₀,
  contrapose! h₁,
  apply dvd_antisymm h₀ h₁,
end

-- Prueba
-- ======

/-
m n : ℕ,
h : m ∣ n ∧ m ≠ n
⊢ m ∣ n ∧ ¬n ∣ m
  >> rcases h with ⟨h₀, h₁⟩,
h₀ : m ∣ n,
h₁ : m ≠ n
⊢ m ∣ n ∧ ¬n ∣ m
  >> split,
| ⊢ m ∣ n
|   >>   exact h₀,
⊢ ¬n ∣ m
  >> contrapose! h₁,
h₁ : n ∣ m
⊢ m = n
  >> apply dvd_antisymm h₀ h₁,
no goals
-/


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/
import algebra.associated
import linear_algebra.basic
import order.zorn
import order.atoms
import order.compactly_generated
import tactic.abel
import data.nat.choose.sum
import linear_algebra.finsupp
/-!

# Ideals over a ring

This file defines `ideal R`, the type of (left) ideals over a ring `R`.
Note that over commutative rings, left ideals and two-sided ideals are equivalent.

## Implementation notes

`ideal R` is implemented using `submodule R R`, where `•` is interpreted as `*`.

## TODO

Support right ideals, and two-sided ideals over non-commutative rings.
-/

universes u v w
variables {α : Type u} {β : Type v}
open set function

open_locale classical big_operators pointwise

/-- A (left) ideal in a semiring `R` is an additive submonoid `s` such that
`a * b ∈ s` whenever `b ∈ s`. If `R` is a ring, then `s` is an additive subgroup.  -/
@[reducible] def ideal (R : Type u) [semiring R] := submodule R R

section semiring

namespace ideal
variables [semiring α] (I : ideal α) {a b : α}

protected lemma zero_mem : (0 : α) ∈ I := I.zero_mem

protected lemma add_mem : a ∈ I → b ∈ I → a + b ∈ I := I.add_mem

variables (a)
lemma mul_mem_left : b ∈ I → a * b ∈ I := I.smul_mem a
variables {a}

@[ext] lemma ext {I J : ideal α} (h : ∀ x, x ∈ I ↔ x ∈ J) : I = J :=
submodule.ext h

lemma sum_mem (I : ideal α) {ι : Type*} {t : finset ι} {f : ι → α} :
  (∀c∈t, f c ∈ I) → (∑ i in t, f i) ∈ I := submodule.sum_mem I

theorem eq_top_of_unit_mem
  (x y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ :=
eq_top_iff.2 $ λ z _, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ I : I.mul_mem_left _ hx

theorem eq_top_of_is_unit_mem {x} (hx : x ∈ I) (h : is_unit x) : I = ⊤ :=
let ⟨y, hy⟩ := h.exists_left_inv in eq_top_of_unit_mem I x y hx hy

theorem eq_top_iff_one : I = ⊤ ↔ (1:α) ∈ I :=
⟨by rintro rfl; trivial,
 λ h, eq_top_of_unit_mem _ _ 1 h (by simp)⟩

theorem ne_top_iff_one : I ≠ ⊤ ↔ (1:α) ∉ I :=
not_congr I.eq_top_iff_one

@[simp]
theorem unit_mul_mem_iff_mem {x y : α} (hy : is_unit y) : y * x ∈ I ↔ x ∈ I :=
begin
  refine ⟨λ h, _, λ h, I.mul_mem_left y h⟩,
  obtain ⟨y', hy'⟩ := hy.exists_left_inv,
  have := I.mul_mem_left y' h,
  rwa [← mul_assoc, hy', one_mul] at this,
end

/-- The ideal generated by a subset of a ring -/
def span (s : set α) : ideal α := submodule.span α s

@[simp] lemma submodule_span_eq {s : set α} :
  submodule.span α s = ideal.span s :=
rfl

@[simp] lemma span_empty : span (∅ : set α) = ⊥ := submodule.span_empty

@[simp] lemma span_univ : span (set.univ : set α) = ⊤ := submodule.span_univ

lemma span_union (s t : set α) : span (s ∪ t) = span s ⊔ span t :=
submodule.span_union _ _

lemma span_Union {ι} (s : ι → set α) : span (⋃ i, s i) = ⨆ i, span (s i) :=
submodule.span_Union _

lemma mem_span {s : set α} (x) : x ∈ span s ↔ ∀ p : ideal α, s ⊆ p → x ∈ p :=
mem_Inter₂

lemma subset_span {s : set α} : s ⊆ span s := submodule.subset_span

lemma span_le {s : set α} {I} : span s ≤ I ↔ s ⊆ I := submodule.span_le

lemma span_mono {s t : set α} : s ⊆ t → span s ≤ span t := submodule.span_mono

@[simp] lemma span_eq : span (I : set α) = I := submodule.span_eq _

@[simp] lemma span_singleton_one : span ({1} : set α) = ⊤ :=
(eq_top_iff_one _).2 $ subset_span $ mem_singleton _

lemma mem_span_insert {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃ a (z ∈ span s), x = a * y + z := submodule.mem_span_insert

lemma mem_span_singleton' {x y : α} :
  x ∈ span ({y} : set α) ↔ ∃ a, a * y = x := submodule.mem_span_singleton

lemma span_insert (x) (s : set α) : span (insert x s) = span ({x} : set α) ⊔ span s :=
submodule.span_insert x s

lemma span_eq_bot {s : set α} : span s = ⊥ ↔ ∀ x ∈ s, (x:α) = 0 := submodule.span_eq_bot

@[simp] lemma span_singleton_eq_bot {x} : span ({x} : set α) = ⊥ ↔ x = 0 :=
submodule.span_singleton_eq_bot

@[simp] lemma span_zero : span (0 : set α) = ⊥ := by rw [←set.singleton_zero, span_singleton_eq_bot]

@[simp] lemma span_one : span (1 : set α) = ⊤ := by rw [←set.singleton_one, span_singleton_one]

lemma span_eq_top_iff_finite (s : set α) :
  span s = ⊤ ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ span (s' : set α) = ⊤ :=
begin
  simp_rw eq_top_iff_one,
  exact ⟨submodule.mem_span_finite_of_mem_span, λ ⟨s', h₁, h₂⟩, span_mono h₁ h₂⟩
end

/--
The ideal generated by an arbitrary binary relation.
-/
def of_rel (r : α → α → Prop) : ideal α :=
submodule.span α { x | ∃ (a b) (h : r a b), x + b = a }

/-- An ideal `P` of a ring `R` is prime if `P ≠ R` and `xy ∈ P → x ∈ P ∨ y ∈ P` -/
class is_prime (I : ideal α) : Prop :=
(ne_top' : I ≠ ⊤)
(mem_or_mem' : ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I)

theorem is_prime_iff {I : ideal α} :
  is_prime I ↔ I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

theorem is_prime.ne_top {I : ideal α} (hI : I.is_prime) : I ≠ ⊤ := hI.1

theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2

theorem is_prime.mem_or_mem_of_mul_eq_zero {I : ideal α} (hI : I.is_prime)
  {x y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
hI.mem_or_mem (h.symm ▸ I.zero_mem)

theorem is_prime.mem_of_pow_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (H : r^n ∈ I) : r ∈ I :=
begin
  induction n with n ih,
  { rw pow_zero at H, exact (mt (eq_top_iff_one _).2 hI.1).elim H },
  { rw pow_succ at H, exact or.cases_on (hI.mem_or_mem H) id ih }
end

lemma not_is_prime_iff {I : ideal α} : ¬ I.is_prime ↔ I = ⊤ ∨ ∃ (x ∉ I) (y ∉ I), x * y ∈ I :=
begin
  simp_rw [ideal.is_prime_iff, not_and_distrib, ne.def, not_not, not_forall, not_or_distrib],
  exact or_congr iff.rfl
    ⟨λ ⟨x, y, hxy, hx, hy⟩, ⟨x, hx, y, hy, hxy⟩, λ ⟨x, hx, y, hy, hxy⟩, ⟨x, y, hxy, hx, hy⟩⟩
end

theorem zero_ne_one_of_proper {I : ideal α} (h : I ≠ ⊤) : (0:α) ≠ 1 :=
λ hz, I.ne_top_iff_one.1 h $ hz ▸ I.zero_mem

lemma bot_prime {R : Type*} [ring R] [is_domain R] : (⊥ : ideal R).is_prime :=
⟨λ h, one_ne_zero (by rwa [ideal.eq_top_iff_one, submodule.mem_bot] at h),
 λ x y h, mul_eq_zero.mp (by simpa only [submodule.mem_bot] using h)⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
class is_maximal (I : ideal α) : Prop := (out : is_coatom I)

theorem is_maximal_def {I : ideal α} : I.is_maximal ↔ is_coatom I := ⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_maximal.ne_top {I : ideal α} (h : I.is_maximal) : I ≠ ⊤ := (is_maximal_def.1 h).1

theorem is_maximal_iff {I : ideal α} : I.is_maximal ↔
  (1:α) ∉ I ∧ ∀ (J : ideal α) x, I ≤ J → x ∉ I → x ∈ J → (1:α) ∈ J :=
is_maximal_def.trans $ and_congr I.ne_top_iff_one $ forall_congr $ λ J,
by rw [lt_iff_le_not_le]; exact
 ⟨λ H x h hx₁ hx₂, J.eq_top_iff_one.1 $
    H ⟨h, not_subset.2 ⟨_, hx₂, hx₁⟩⟩,
  λ H ⟨h₁, h₂⟩, let ⟨x, xJ, xI⟩ := not_subset.1 h₂ in
   J.eq_top_iff_one.2 $ H x h₁ xI xJ⟩

theorem is_maximal.eq_of_le {I J : ideal α}
  (hI : I.is_maximal) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
eq_iff_le_not_lt.2 ⟨IJ, λ h, hJ (hI.1.2 _ h)⟩

instance : is_coatomic (ideal α) :=
begin
  apply complete_lattice.coatomic_of_top_compact,
  rw ←span_singleton_one,
  exact submodule.singleton_span_is_compact_element 1,
end

/-- **Krull's theorem**: if `I` is an ideal that is not the whole ring, then it is included in some
    maximal ideal. -/
theorem exists_le_maximal (I : ideal α) (hI : I ≠ ⊤) :
  ∃ M : ideal α, M.is_maximal ∧ I ≤ M :=
let ⟨m, hm⟩ := (eq_top_or_exists_le_coatom I).resolve_left hI in ⟨m, ⟨⟨hm.1⟩, hm.2⟩⟩

variables (α)

/-- Krull's theorem: a nontrivial ring has a maximal ideal. -/
theorem exists_maximal [nontrivial α] : ∃ M : ideal α, M.is_maximal :=
let ⟨I, ⟨hI, _⟩⟩ := exists_le_maximal (⊥ : ideal α) bot_ne_top in ⟨I, hI⟩

variables {α}

instance [nontrivial α] : nontrivial (ideal α) :=
begin
  rcases @exists_maximal α _ _ with ⟨M, hM, _⟩,
  exact nontrivial_of_ne M ⊤ hM
end

/-- If P is not properly contained in any maximal ideal then it is not properly contained
  in any proper ideal -/
lemma maximal_of_no_maximal {R : Type u} [semiring R] {P : ideal R}
(hmax : ∀ m : ideal R, P < m → ¬is_maximal m) (J : ideal R) (hPJ : P < J) : J = ⊤ :=
begin
  by_contradiction hnonmax,
  rcases exists_le_maximal J hnonmax with ⟨M, hM1, hM2⟩,
  exact hmax M (lt_of_lt_of_le hPJ hM2) hM1,
end

theorem mem_span_pair {x y z : α} :
  z ∈ span ({x, y} : set α) ↔ ∃ a b, a * x + b * y = z :=
by simp [mem_span_insert, mem_span_singleton', @eq_comm _ _ z]

theorem is_maximal.exists_inv {I : ideal α}
  (hI : I.is_maximal) {x} (hx : x ∉ I) : ∃ y, ∃ i ∈ I, y * x + i = 1 :=
begin
  cases is_maximal_iff.1 hI with H₁ H₂,
  rcases mem_span_insert.1 (H₂ (span (insert x I)) x
    (set.subset.trans (subset_insert _ _) subset_span)
    hx (subset_span (mem_insert _ _))) with ⟨y, z, hz, hy⟩,
  refine ⟨y, z, _, hy.symm⟩,
  rwa ← span_eq I,
end

section lattice
variables {R : Type u} [semiring R]

lemma mem_sup_left {S T : ideal R} : ∀ {x : R}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : ideal R} : ∀ {x : R}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma mem_Sup_of_mem {S : set (ideal R)} {s : ideal R}
  (hs : s ∈ S) : ∀ {x : R}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

theorem mem_Inf {s : set (ideal R)} {x : R} :
  x ∈ Inf s ↔ ∀ ⦃I⦄, I ∈ s → x ∈ I :=
⟨λ hx I his, hx I ⟨I, infi_pos his⟩, λ H I ⟨J, hij⟩, hij ▸ λ S ⟨hj, hS⟩, hS ▸ H hj⟩

@[simp] lemma mem_inf {I J : ideal R} {x : R} : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl

@[simp] lemma mem_infi {ι : Sort*} {I : ι → ideal R} {x : R} : x ∈ infi I ↔ ∀ i, x ∈ I i :=
submodule.mem_infi _

@[simp] lemma mem_bot {x : R} : x ∈ (⊥ : ideal R) ↔ x = 0 :=
submodule.mem_bot _

end lattice

section pi
variables (ι : Type v)

/-- `I^n` as an ideal of `R^n`. -/
def pi : ideal (ι → α) :=
{ carrier := { x | ∀ i, x i ∈ I },
  zero_mem' := λ i, I.zero_mem,
  add_mem' := λ a b ha hb i, I.add_mem (ha i) (hb i),
  smul_mem' := λ a b hb i, I.mul_mem_left (a i) (hb i) }

lemma mem_pi (x : ι → α) : x ∈ I.pi ι ↔ ∀ i, x i ∈ I := iff.rfl

end pi

end ideal

end semiring

section comm_semiring

variables {a b : α}

-- A separate namespace definition is needed because the variables were historically in a different
-- order.
namespace ideal
variables [comm_semiring α] (I : ideal α)

@[simp]
theorem mul_unit_mem_iff_mem {x y : α} (hy : is_unit y) : x * y ∈ I ↔ x ∈ I :=
mul_comm y x ▸ unit_mul_mem_iff_mem I hy

lemma mem_span_singleton {x y : α} :
  x ∈ span ({y} : set α) ↔ y ∣ x :=
mem_span_singleton'.trans $ exists_congr $ λ _, by rw [eq_comm, mul_comm]

lemma span_singleton_le_span_singleton {x y : α} :
  span ({x} : set α) ≤ span ({y} : set α) ↔ y ∣ x :=
span_le.trans $ singleton_subset_iff.trans mem_span_singleton

lemma span_singleton_eq_span_singleton {α : Type u} [comm_ring α] [is_domain α] {x y : α} :
  span ({x} : set α) = span ({y} : set α) ↔ associated x y :=
begin
  rw [←dvd_dvd_iff_associated, le_antisymm_iff, and_comm],
  apply and_congr;
  rw span_singleton_le_span_singleton,
end

lemma span_singleton_mul_right_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({x * a} : set α) = span {x} :=
begin
  apply le_antisymm,
  { rw span_singleton_le_span_singleton, use a},
  { rw span_singleton_le_span_singleton, rw is_unit.mul_right_dvd h2}
end

lemma span_singleton_mul_left_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({a * x} : set α) = span {x} := by rw [mul_comm, span_singleton_mul_right_unit h2]

lemma span_singleton_eq_top {x} : span ({x} : set α) = ⊤ ↔ is_unit x :=
by rw [is_unit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one,
  eq_top_iff]

theorem span_singleton_prime {p : α} (hp : p ≠ 0) :
  is_prime (span ({p} : set α)) ↔ prime p :=
by simp [is_prime_iff, prime, span_singleton_eq_top, hp, mem_span_singleton]

theorem is_maximal.is_prime {I : ideal α} (H : I.is_maximal) : I.is_prime :=
⟨H.1.1, λ x y hxy, or_iff_not_imp_left.2 $ λ hx, begin
  let J : ideal α := submodule.span α (insert x ↑I),
  have IJ : I ≤ J  := (set.subset.trans (subset_insert _ _) subset_span),
  have xJ : x ∈ J := ideal.subset_span (set.mem_insert x I),
  cases is_maximal_iff.1 H with _ oJ,
  specialize oJ J x IJ hx xJ,
  rcases submodule.mem_span_insert.mp oJ with ⟨a, b, h, oe⟩,
  obtain (F : y * 1 = y * (a • x + b)) := congr_arg (λ g : α, y * g) oe,
  rw [← mul_one y, F, mul_add, mul_comm, smul_eq_mul, mul_assoc],
  refine submodule.add_mem I (I.mul_mem_left a hxy) (submodule.smul_mem I y _),
  rwa submodule.span_eq at h,
end⟩

@[priority 100] -- see Note [lower instance priority]
instance is_maximal.is_prime' (I : ideal α) : ∀ [H : I.is_maximal], I.is_prime :=
is_maximal.is_prime

lemma span_singleton_lt_span_singleton [comm_ring β] [is_domain β] {x y : β} :
  span ({x} : set β) < span ({y} : set β) ↔ dvd_not_unit y x :=
by rw [lt_iff_le_not_le, span_singleton_le_span_singleton, span_singleton_le_span_singleton,
  dvd_and_not_dvd_iff]

lemma factors_decreasing [comm_ring β] [is_domain β]
  (b₁ b₂ : β) (h₁ : b₁ ≠ 0) (h₂ : ¬ is_unit b₂) :
  span ({b₁ * b₂} : set β) < span {b₁} :=
lt_of_le_not_le (ideal.span_le.2 $ singleton_subset_iff.2 $
  ideal.mem_span_singleton.2 ⟨b₂, rfl⟩) $ λ h,
h₂ $ is_unit_of_dvd_one _ $ (mul_dvd_mul_iff_left h₁).1 $
by rwa [mul_one, ← ideal.span_singleton_le_span_singleton]

variables (b)
lemma mul_mem_right (h : a ∈ I) : a * b ∈ I := mul_comm b a ▸ I.mul_mem_left b h
variables {b}

lemma pow_mem_of_mem (ha : a ∈ I) (n : ℕ) (hn : 0 < n) : a ^ n ∈ I :=
nat.cases_on n (not.elim dec_trivial) (λ m hm, (pow_succ a m).symm ▸ I.mul_mem_right (a^m) ha) hn

theorem is_prime.mul_mem_iff_mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I ↔ x ∈ I ∨ y ∈ I :=
λ x y, ⟨hI.mem_or_mem, by { rintro (h | h), exacts [I.mul_mem_right y h, I.mul_mem_left x h] }⟩

theorem is_prime.pow_mem_iff_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (hn : 0 < n) : r ^ n ∈ I ↔ r ∈ I :=
⟨hI.mem_of_pow_mem n, (λ hr, I.pow_mem_of_mem hr n hn)⟩

theorem pow_multiset_sum_mem_span_pow (s : multiset α) (n : ℕ) :
  s.sum ^ (s.card * n + 1) ∈ span ((s.map (λ x, x ^ (n + 1))).to_finset : set α) :=
begin
  induction s using multiset.induction_on with a s hs,
  { simp },
  simp only [finset.coe_insert, multiset.map_cons, multiset.to_finset_cons, multiset.sum_cons,
    multiset.card_cons, add_pow],
  refine submodule.sum_mem _ _,
  intros c hc,
  rw mem_span_insert,
  by_cases h : n+1 ≤ c,
  { refine ⟨a ^ (c - (n + 1)) * s.sum ^ ((s.card + 1) * n + 1 - c) *
      (((s.card + 1) * n + 1).choose c), 0, submodule.zero_mem _, _⟩,
    rw mul_comm _ (a ^ (n + 1)),
    simp_rw ← mul_assoc,
    rw [← pow_add, add_zero, add_tsub_cancel_of_le h], },
  { use 0,
    simp_rw [zero_mul, zero_add],
    refine ⟨_,_,rfl⟩,
    replace h : c ≤ n := nat.lt_succ_iff.mp (not_le.mp h),
    have : (s.card + 1) * n + 1 - c = s.card * n + 1 + (n - c),
    { rw [add_mul, one_mul, add_assoc, add_comm n 1, ← add_assoc, add_tsub_assoc_of_le h] },
    rw [this, pow_add],
    simp_rw [mul_assoc, mul_comm (s.sum ^ (s.card * n + 1)), ← mul_assoc],
    exact mul_mem_left _ _ hs }
end

theorem sum_pow_mem_span_pow {ι} (s : finset ι) (f : ι → α) (n : ℕ) :
  (∑ i in s, f i) ^ (s.card * n + 1) ∈ span ((λ i, f i ^ (n + 1)) '' s) :=
begin
  convert pow_multiset_sum_mem_span_pow (s.1.map f) n,
  { rw multiset.card_map, refl },
  rw [multiset.map_map, multiset.to_finset_map, finset.val_to_finset, finset.coe_image]
end

theorem span_pow_eq_top (s : set α)
  (hs : span s = ⊤) (n : ℕ) : span ((λ x, x ^ n) '' s) = ⊤ :=
begin
  rw eq_top_iff_one,
  cases n,
  { obtain rfl | ⟨x, hx⟩ := eq_empty_or_nonempty s,
    { rw [set.image_empty, hs],
      trivial },
    { exact subset_span ⟨_, hx, pow_zero _⟩ } },
  rw [eq_top_iff_one, span, finsupp.mem_span_iff_total] at hs,
  rcases hs with ⟨f, hf⟩,
  change f.support.sum (λ a, f a * a) = 1 at hf,
  have := sum_pow_mem_span_pow f.support (λ a, f a * a) n,
  rw [hf, one_pow] at this,
  refine (span_le).mpr _ this,
  rintros _ hx,
  simp_rw [finset.mem_coe, set.mem_image] at hx,
  rcases hx with ⟨x, hx, rfl⟩,
  have : span ({x ^ (n + 1)} : set α) ≤ span ((λ (x : α), x ^ (n + 1)) '' s),
  { rw [span_le, set.singleton_subset_iff],
    exact subset_span ⟨x, x.prop, rfl⟩ },
  refine this _,
  rw [mul_pow, mem_span_singleton],
  exact ⟨f x ^ (n + 1), mul_comm _ _⟩
end

end ideal

end comm_semiring

section ring

namespace ideal

variables [ring α] (I : ideal α) {a b : α}

protected lemma neg_mem_iff : -a ∈ I ↔ a ∈ I := neg_mem_iff
protected lemma add_mem_iff_left : b ∈ I → (a + b ∈ I ↔ a ∈ I) := I.add_mem_iff_left
protected lemma add_mem_iff_right : a ∈ I → (a + b ∈ I ↔ b ∈ I) := I.add_mem_iff_right
protected lemma sub_mem : a ∈ I → b ∈ I → a - b ∈ I := sub_mem

lemma mem_span_insert' {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃a, x + a * y ∈ span s := submodule.mem_span_insert'

end ideal

end ring

section division_ring
variables {K : Type u} [division_ring K] (I : ideal K)

namespace ideal

/-- All ideals in a division ring are trivial. -/
lemma eq_bot_or_top : I = ⊥ ∨ I = ⊤ :=
begin
  rw or_iff_not_imp_right,
  change _ ≠ _ → _,
  rw ideal.ne_top_iff_one,
  intro h1,
  rw eq_bot_iff,
  intros r hr,
  by_cases H : r = 0, {simpa},
  simpa [H, h1] using I.mul_mem_left r⁻¹ hr,
end

lemma eq_bot_of_prime [h : I.is_prime] : I = ⊥ :=
or_iff_not_imp_right.mp I.eq_bot_or_top h.1

lemma bot_is_maximal : is_maximal (⊥ : ideal K) :=
⟨⟨λ h, absurd ((eq_top_iff_one (⊤ : ideal K)).mp rfl) (by rw ← h; simp),
λ I hI, or_iff_not_imp_left.mp (eq_bot_or_top I) (ne_of_gt hI)⟩⟩

end ideal

end division_ring

section comm_ring

namespace ideal

theorem mul_sub_mul_mem {R : Type*} [comm_ring R] (I : ideal R) {a b c d : R}
  (h1 : a - b ∈ I) (h2 : c - d ∈ I) : a * c - b * d ∈ I :=
begin
  rw (show a * c - b * d = (a - b) * c + b * (c - d), by {rw [sub_mul, mul_sub], abel}),
  exact I.add_mem (I.mul_mem_right _ h1) (I.mul_mem_left _ h2),
end

end ideal

end comm_ring

namespace ring

variables {R : Type*} [comm_ring R]

lemma not_is_field_of_subsingleton {R : Type*} [ring R] [subsingleton R] : ¬ is_field R :=
λ ⟨⟨x, y, hxy⟩, _, _⟩, hxy (subsingleton.elim x y)

lemma exists_not_is_unit_of_not_is_field [nontrivial R] (hf : ¬ is_field R) :
  ∃ x ≠ (0 : R), ¬ is_unit x :=
begin
  have : ¬ _ := λ h, hf ⟨exists_pair_ne R, mul_comm, h⟩,
  simp_rw is_unit_iff_exists_inv,
  push_neg at ⊢ this,
  obtain ⟨x, hx, not_unit⟩ := this,
  exact ⟨x, hx, not_unit⟩
end

lemma not_is_field_iff_exists_ideal_bot_lt_and_lt_top [nontrivial R] :
  ¬ is_field R ↔ ∃ I : ideal R, ⊥ < I ∧ I < ⊤ :=
begin
  split,
  { intro h,
    obtain ⟨x, nz, nu⟩ := exists_not_is_unit_of_not_is_field h,
    use ideal.span {x},
    rw [bot_lt_iff_ne_bot, lt_top_iff_ne_top],
    exact ⟨mt ideal.span_singleton_eq_bot.mp nz, mt ideal.span_singleton_eq_top.mp nu⟩ },
  { rintros ⟨I, bot_lt, lt_top⟩ hf,
    obtain ⟨x, mem, ne_zero⟩ := set_like.exists_of_lt bot_lt,
    rw submodule.mem_bot at ne_zero,
    obtain ⟨y, hy⟩ := hf.mul_inv_cancel ne_zero,
    rw [lt_top_iff_ne_top, ne.def, ideal.eq_top_iff_one, ← hy] at lt_top,
    exact lt_top (I.mul_mem_right _ mem), }
end

lemma not_is_field_iff_exists_prime [nontrivial R] :
  ¬ is_field R ↔ ∃ p : ideal R, p ≠ ⊥ ∧ p.is_prime :=
not_is_field_iff_exists_ideal_bot_lt_and_lt_top.trans
  ⟨λ ⟨I, bot_lt, lt_top⟩, let ⟨p, hp, le_p⟩ := I.exists_le_maximal (lt_top_iff_ne_top.mp lt_top) in
    ⟨p, bot_lt_iff_ne_bot.mp (lt_of_lt_of_le bot_lt le_p), hp.is_prime⟩,
   λ ⟨p, ne_bot, prime⟩, ⟨p, bot_lt_iff_ne_bot.mpr ne_bot, lt_top_iff_ne_top.mpr prime.1⟩⟩

/-- When a ring is not a field, the maximal ideals are nontrivial. -/
lemma ne_bot_of_is_maximal_of_not_is_field [nontrivial R] {M : ideal R} (max : M.is_maximal)
  (not_field : ¬ is_field R) : M ≠ ⊥ :=
begin
  rintros h,
  rw h at max,
  rcases max with ⟨⟨h1, h2⟩⟩,
  obtain ⟨I, hIbot, hItop⟩ := not_is_field_iff_exists_ideal_bot_lt_and_lt_top.mp not_field,
  exact ne_of_lt hItop (h2 I hIbot),
end

end ring

namespace ideal

/-- Maximal ideals in a non-field are nontrivial. -/
variables {R : Type u} [comm_ring R] [nontrivial R]
lemma bot_lt_of_maximal (M : ideal R) [hm : M.is_maximal] (non_field : ¬ is_field R) : ⊥ < M :=
begin
  rcases (ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top.1 non_field)
    with ⟨I, Ibot, Itop⟩,
  split, { simp },
  intro mle,
  apply @irrefl _ (<) _ (⊤ : ideal R),
  have : M = ⊥ := eq_bot_iff.mpr mle,
  rw this at *,
  rwa hm.1.2 I Ibot at Itop,
end

end ideal

variables {a b : α}

/-- The set of non-invertible elements of a monoid. -/
def nonunits (α : Type u) [monoid α] : set α := { a | ¬is_unit a }

@[simp] theorem mem_nonunits_iff [monoid α] : a ∈ nonunits α ↔ ¬ is_unit a := iff.rfl

theorem mul_mem_nonunits_right [comm_monoid α] :
  b ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_right

theorem mul_mem_nonunits_left [comm_monoid α] :
  a ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_left

theorem zero_mem_nonunits [semiring α] : 0 ∈ nonunits α ↔ (0:α) ≠ 1 :=
not_congr is_unit_zero_iff

@[simp] theorem one_not_mem_nonunits [monoid α] : (1:α) ∉ nonunits α :=
not_not_intro is_unit_one

theorem coe_subset_nonunits [semiring α] {I : ideal α} (h : I ≠ ⊤) :
  (I : set α) ⊆ nonunits α :=
λ x hx hu, h $ I.eq_top_of_is_unit_mem hx hu

lemma exists_max_ideal_of_mem_nonunits [comm_semiring α] (h : a ∈ nonunits α) :
  ∃ I : ideal α, I.is_maximal ∧ a ∈ I :=
begin
  have : ideal.span ({a} : set α) ≠ ⊤,
  { intro H, rw ideal.span_singleton_eq_top at H, contradiction },
  rcases ideal.exists_le_maximal _ this with ⟨I, Imax, H⟩,
  use [I, Imax], apply H, apply ideal.subset_span, exact set.mem_singleton a
end


import init.data.set
import set_theory.cardinal.basic
import helper

open set

-- proof: https://en.wikipedia.org/wiki/Cantor%27s_theorem#Proof

theorem cantor_surjective {α : Type} (f : α → set α) :
  ¬function.surjective f :=
begin
  set B := {x : α | x ∉ f x},
  by_contradiction,
  have : ∃ (ξ : α), f ξ = B,
  { exact h B, },
  { rcases this with ⟨ξ, fx⟩,
    have : ξ ∈ B ↔ ξ ∉ f(ξ),
    { exact mem_set_of, },
    { rw fx at this,
      exact p_equiv_np_implies_false _ this, }}
end

theorem cantor_surjective' {α : Type} (f : α → set α) :
  ¬function.surjective f :=
begin
  set B := {x : α | x ∉ f x},
  by_contradiction,
  obtain ⟨ξ, fx⟩ : ∃ ξ, f ξ = B := h B,
  have : ξ ∈ B ↔ ξ ∉ f(ξ),
  { exact mem_set_of, },
  { rw fx at this,
    exact p_equiv_np_implies_false _ this, }
end


import linear_algebra.vandermonde
import linear_algebra.matrix.nondegenerate
import to_mathlib.polynomial.degree_lt_le

namespace matrix
open_locale big_operators matrix
open finset
lemma det_vandermonde_ne_zero_of_injective {R : Type*} [comm_ring R]
[is_domain R] {n : ℕ} (α : fin n ↪ R) : (vandermonde α).det ≠ 0 :=
begin
  simp_rw [det_vandermonde, prod_ne_zero_iff, mem_filter,
  mem_univ, forall_true_left, true_and, sub_ne_zero, ne.def,
  embedding_like.apply_eq_iff_eq],
  rintro _ _ _ rfl, apply lt_irrefl _ (by assumption)
end

theorem vandermonde_invertibility' {R : Type*} [comm_ring R]
[is_domain R] {n : ℕ} (α : fin n ↪ R) {f : fin n → R}
(h₂ : ∀ j, ∑ i : fin n, (α j ^ (i : ℕ)) * f i = 0) : f = 0
:= by {apply eq_zero_of_mul_vec_eq_zero (det_vandermonde_ne_zero_of_injective α), ext, apply h₂}

theorem vandermonde_invertibility {R : Type*} [comm_ring R]
[is_domain R] {n : ℕ}
{α : fin n ↪ R} {f : fin n → R}
(h₂ : ∀ j, ∑ i, f i * (α j ^ (i : ℕ))  = 0) : f = 0
:= by {apply vandermonde_invertibility' α, simp_rw mul_comm, exact h₂}

theorem vandermonde_invertibility_transposed {R : Type*} [comm_ring R]
[is_domain R] {n : ℕ}
{α : fin n ↪ R} {f : fin n → R}
(h₂ : ∀ i : fin n, ∑ j : fin n, f j * (α j ^ (i : ℕ)) = 0) : f = 0
:= by {apply eq_zero_of_vec_mul_eq_zero
(det_vandermonde_ne_zero_of_injective α), ext, apply h₂}

end matrix

namespace polynomial
open_locale polynomial big_operators

open linear_equiv matrix polynomial

theorem vandermonde_invertibility {R : Type*} [comm_ring R] [is_domain R] {n : ℕ}
(α : fin n ↪ R) (p : degree_lt R n) (h₁ : ∀ j, (p : R[X]).is_root (α j)) : p = 0 :=
begin
  simp_rw degree_lt.to_tuple_root at h₁,
  exact (degree_lt.to_tuple_eq_zero_iff p).mp (vandermonde_invertibility h₁)
end

theorem vandermonde_invertibility_tranposed {R : Type*} [comm_ring R] [is_domain R]
{n : ℕ} (α : fin n ↪ R) (p : degree_lt R n)
(h₁ : ∀ i : fin n, ∑ j : fin n, (p : R[X]).coeff j * (α j ^ (i : ℕ)) = 0) : p = 0 :=
(degree_lt.to_tuple_eq_zero_iff p).mp (vandermonde_invertibility_transposed h₁)

theorem vandermonde_agreement {R : Type*} [comm_ring R] [is_domain R] {n : ℕ}
(α : fin n ↪ R) {p q : R[X]} (h₀ : (p - q) ∈ degree_lt R n)
(h₂ : ∀ j, p.eval (α j) = q.eval (α j)) : p = q :=
begin
  rw ← sub_eq_zero, have vi := vandermonde_invertibility α ⟨p - q, h₀⟩,
  simp only [submodule.coe_mk, is_root.def, eval_sub, submodule.mk_eq_zero] at vi,
  exact vi (λ _, sub_eq_zero.mpr (h₂ _)),
end

end polynomial


/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import tactic.linarith

/-!
# An MIU Decision Procedure in Lean

The [MIU formal system](https://en.wikipedia.org/wiki/MU_puzzle) was introduced by Douglas
Hofstadter in the first chapter of his 1979 book,
[Gödel, Escher, Bach](https://en.wikipedia.org/wiki/G%C3%B6del,_Escher,_Bach).
The system is defined by four rules of inference, one axiom, and an alphabet of three symbols:
`M`, `I`, and `U`.

Hofstadter's central question is: can the string `"MU"` be derived?

It transpires that there is a simple decision procedure for this system. A string is derivable if
and only if it starts with `M`, contains no other `M`s, and the number of `I`s in the string is
congruent to 1 or 2 modulo 3.

The principal aim of this project is to give a Lean proof that the derivability of a string is a
decidable predicate.

## The MIU System

In Hofstadter's description, an _atom_ is any one of `M`, `I` or `U`. A _string_ is a finite
sequence of zero or more symbols. To simplify notation, we write a sequence `[I,U,U,M]`,
for example, as `IUUM`.

The four rules of inference are:

1. xI → xIU,
2. Mx → Mxx,
3. xIIIy → xUy,
4. xUUy → xy,

where the notation α → β is to be interpreted as 'if α is derivable, then β is derivable'.

Additionally, he has an axiom:

* `MI` is derivable.

In Lean, it is natural to treat the rules of inference and the axiom on an equal footing via an
inductive data type `derivable` designed so that `derivable x` represents the notion that the string
`x` can be derived from the axiom by the rules of inference. The axiom is represented as a
nonrecursive constructor for `derivable`. This mirrors the translation of Peano's axiom '0 is a
natural number' into the nonrecursive constructor `zero` of the inductive type `nat`.

## References

* [Jeremy Avigad, Leonardo de Moura and Soonho Kong, _Theorem Proving in Lean_]
  [avigad_moura_kong-2017]
* [Douglas R Hofstadter, _Gödel, Escher, Bach_][Hofstadter-1979]

## Tags

miu, derivable strings

-/

namespace miu

/-!
### Declarations and instance derivations for `miu_atom` and `miustr`
-/

/--
The atoms of MIU can be represented as an enumerated type in Lean.
-/
@[derive decidable_eq]
inductive miu_atom : Type
| M : miu_atom
| I : miu_atom
| U : miu_atom

/-!
The annotation `@[derive decidable_eq]` above assigns the attribute `derive` to `miu_atom`, through
which Lean automatically derives that `miu_atom` is an instance of `decidable_eq`. The use of
`derive` is crucial in this project and will lead to the automatic derivation of decidability.
-/

open miu_atom

/--
We show that the type `miu_atom` is inhabited, giving `M` (for no particular reason) as the default
element.
-/
instance miu_atom_inhabited : inhabited miu_atom :=
inhabited.mk M

/--
`miu_atom.repr` is the 'natural' function from `miu_atom` to `string`.
-/
def miu_atom.repr : miu_atom → string
| M := "M"
| I := "I"
| U := "U"

/--
Using `miu_atom.repr`, we prove that ``miu_atom` is an instance of `has_repr`.
-/
instance : has_repr miu_atom :=
⟨λ u, u.repr⟩

/--
For simplicity, an `miustr` is just a list of elements of type `miu_atom`.
-/
@[derive [has_append, has_mem miu_atom]]
def miustr := list miu_atom

/--
For display purposes, an `miustr` can be represented as a `string`.
-/
def miustr.mrepr : miustr → string
| [] := ""
| (c::cs) := c.repr ++ (miustr.mrepr cs)

instance miurepr : has_repr miustr :=
⟨λ u, u.mrepr⟩

/--
In the other direction, we set up a coercion from `string` to `miustr`.
-/
def lchar_to_miustr : (list char) → miustr
| [] := []
| (c::cs) :=
  let ms := lchar_to_miustr cs in
  match c with
  | 'M' := M::ms
  | 'I' := I::ms
  | 'U' := U::ms
  |  _  := []
  end

instance string_coe_miustr : has_coe string miustr :=
⟨λ st, lchar_to_miustr st.data ⟩

/-!
### Derivability
-/

/--
The inductive type `derivable` has five constructors. The nonrecursive constructor `mk` corresponds
to Hofstadter's axiom that `"MI"` is derivable. Each of the constructors `r1`, `r2`, `r3`, `r4`
corresponds to the one of Hofstadter's rules of inference.
-/
inductive derivable : miustr → Prop
| mk : derivable "MI"
| r1 {x} : derivable (x ++ [I]) → derivable (x ++ [I, U])
| r2 {x} : derivable (M :: x) → derivable (M :: x ++ x)
| r3 {x y} : derivable (x ++ [I, I, I] ++ y) → derivable (x ++ U :: y)
| r4 {x y} : derivable (x ++ [U, U] ++ y) → derivable (x ++ y)

/-!
### Rule usage examples
-/

example (h : derivable "UMI") : derivable "UMIU" :=
begin
  change ("UMIU" : miustr) with [U,M] ++ [I,U],
  exact derivable.r1 h, -- Rule 1
end

example (h : derivable "MIIU") : derivable "MIIUIIU" :=
begin
  change ("MIIUIIU" : miustr) with M :: [I,I,U] ++ [I,I,U],
  exact derivable.r2 h, -- Rule 2
end

example (h : derivable "UIUMIIIMMM") : derivable "UIUMUMMM" :=
begin
  change ("UIUMUMMM" : miustr) with [U,I,U,M] ++ U :: [M,M,M],
  exact derivable.r3 h, -- Rule 3
end

example (h : derivable "MIMIMUUIIM") : derivable "MIMIMIIM" :=
begin
  change ("MIMIMIIM" : miustr) with [M,I,M,I,M] ++ [I,I,M],
  exact derivable.r4 h, -- Rule 4
end

/-!
### Derivability examples
-/

private lemma MIU_der : derivable "MIU":=
begin
  change ("MIU" :miustr) with [M] ++ [I,U],
  apply derivable.r1, -- reduce to deriving "MI",
  constructor, -- which is the base of the inductive construction.
end

example : derivable "MIUIU" :=
begin
  change ("MIUIU" : miustr) with M :: [I,U] ++ [I,U],
  exact derivable.r2 MIU_der, -- `"MIUIU"` can be derived as `"MIU"` can.
end

example : derivable "MUI" :=
begin
  have h₂ : derivable "MII",
  { change ("MII" : miustr) with M :: [I] ++ [I],
    exact derivable.r2 derivable.mk, },
  have h₃ : derivable "MIIII",
  { change ("MIIII" : miustr) with M :: [I,I] ++ [I,I],
    exact derivable.r2 h₂, },
  change ("MUI" : miustr) with [M] ++ U :: [I],
  exact derivable.r3 h₃, -- We prove our main goal using rule 3
end

end miu


import data.real.basic

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc a b c,
  rw mul_comm a b,
  rw mul_assoc b a c,
end

example {a b c : ℝ} : a * (b * c) = b * (a * c) := by ring

example {a b c d : ℝ} (h₁ : c = d*a + b) (h₂ : b = a*d) : c = 2*a*d :=
begin
  rw h₂ at h₁,
  rw mul_comm d a at h₁,
  rw ← two_mul (a * d) at h₁,
  rw ← mul_assoc 2 a d at h₁,
  exact h₁,
end

example {a b c d : ℝ} (h₁ : c = d*a + b) (h₂ : b = a*d) : c = 2*a*d :=
begin
  rw [h₂, mul_comm d a, ← two_mul, ← mul_assoc] at h₁,
  exact h₁,
end

example {a b c d : ℝ} (h₁ : c = d*a + b) (h₂ : b = a*d) : c = 2*a*d :=
begin
  calc
    c   = d*a + b   : by {rw h₁}
    ... = d*a + a*d : by {rw h₂}
    ... = a*d + a*d : by {rw mul_comm d a}
    ... = 2*(a*d)   : by {rw two_mul}
    ... = 2*a*d     : by {rw mul_assoc},
end

example {a b c d : ℝ} (h₁ : c = d*a + b) (h₂ : b = a*d) : c = 2*a*d :=
begin
  calc
    c   = d*a + b   : by {rw h₁}
    ... = d*a + a*d : by {rw h₂}
    ... = 2*a*d     : by {ring},
end

example {a b c d : ℝ} (h₁ : c = b*a - d) (h₂ : d = a*b) : c = 0 :=
begin
  rw [h₂, mul_comm b a, sub_self] at h₁,
  exact h₁,
end

example {a b c d : ℝ} (h₁ : c = b*a - d) (h₂ : d = a*b) : c = 0 :=
begin
  calc
    c   = b*a - d   : by {rw h₁}
    ... = b*a - a*b : by {rw h₂}
    ... = b*a - b*a : by {rw mul_comm}
    ... = 0         : by {rw sub_self},
end

example {a b : ℝ} : (a + b) + a = 2*a + b := by ring

-- 省略．
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 := by ring