import data.polynomial.basic
import data.polynomial.eval

namespace polynomial

variables {R : Type*} {a b c d e : R} [semiring R]

lemma degree_cubic_lt_degree_C_mul_X_cb (ha : a ≠ 0) :
  degree (C b * X ^ 3 + C c * X ^ 2 + C d * X + C e) < degree (C a * X ^ 4) :=
by simpa only [degree_C_mul_X_pow 4 ha] using degree_cubic_lt

@[simp] lemma leading_coeff_quartic (ha : a ≠ 0):
  leading_coeff (C a * X ^ 4 + C b * X ^ 3 + C c * X ^ 2 + C d * X + C e) = a :=
by rw [add_assoc, add_assoc, add_assoc, ← add_assoc (C b * X ^ 3),
         ← add_assoc (C b * X ^ 3 + C c * X ^ 2), add_comm, leading_coeff_add_of_degree_lt $
         degree_cubic_lt_degree_C_mul_X_cb ha, leading_coeff_C_mul_X_pow]

lemma degree_quartic_le : degree (C a * X ^ 4 + C b * X ^ 3 + C c * X ^ 2 + C d * X + C e) ≤ 4 :=
by simpa only [add_assoc] using degree_add_le_of_degree_le (degree_C_mul_X_pow_le 4 a)
  (le_trans degree_cubic_le $ with_bot.coe_le_coe.mpr $ nat.le_succ 3)

@[simp] lemma degree_quartic (ha : a ≠ 0) : degree (C a * X ^ 4 + C b * X ^ 3 + C c * X ^ 2 + C d * X + C e) = 4 :=
begin
  rw [add_assoc, add_assoc, add_assoc, ← add_assoc (C b * X ^ 3),
         ← add_assoc (C b * X ^ 3 + C c * X ^ 2), degree_add_eq_left_of_degree_lt $
        degree_cubic_lt_degree_C_mul_X_cb ha, degree_C_mul_X_pow 4 ha],
  refl
end

@[simp] lemma nat_degree_quartic (ha : a ≠ 0) :
  nat_degree (C a * X ^ 4 + C b * X ^ 3 + C c * X ^ 2 + C d * X + C e) = 4 :=
nat_degree_eq_of_degree_eq_some $ degree_quartic ha

end polynomial


/-
Copyright (c) 2020 Mathieu Guay-Paquet. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mathieu Guay-Paquet
-/
import order.ideal

/-!
# Order filters

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections
require more structure, such as a bottom element, a top element, or
a join-semilattice structure.

- `order.pfilter P`: The type of nonempty, downward directed, upward closed
               subsets of `P`. This is dual to `order.ideal`, so it
               simply wraps `order.ideal Pᵒᵈ`.
- `order.is_pfilter P`: a predicate for when a `set P` is a filter.

Note the relation between `order/filter` and `order/pfilter`: for any
type `α`, `filter α` represents the same mathematical object as
`pfilter (set α)`.

## References

- <https://en.wikipedia.org/wiki/Filter_(mathematics)>

## Tags

pfilter, filter, ideal, dual

-/

namespace order

variables {P : Type*}

/-- A filter on a preorder `P` is a subset of `P` that is
  - nonempty
  - downward directed
  - upward closed. -/
structure pfilter (P) [preorder P] :=
(dual : ideal Pᵒᵈ)

/-- A predicate for when a subset of `P` is a filter. -/
def is_pfilter [preorder P] (F : set P) : Prop :=
@is_ideal Pᵒᵈ _ F

/-- Create an element of type `order.pfilter` from a set satisfying the predicate
`order.is_pfilter`. -/
def is_pfilter.to_pfilter [preorder P] {F : set P} (h : is_pfilter F) : pfilter P :=
⟨h.to_ideal⟩

namespace pfilter

section preorder
variables [preorder P] {x y : P} (F s t : pfilter P)

instance [inhabited P] : inhabited (pfilter P) := ⟨⟨default⟩⟩

/-- A filter on `P` is a subset of `P`. -/
instance : has_coe (pfilter P) (set P) := ⟨λ F, F.dual.carrier⟩

/-- For the notation `x ∈ F`. -/
instance : has_mem P (pfilter P) := ⟨λ x F, x ∈ (F : set P)⟩

@[simp] lemma mem_coe : x ∈ (F : set P) ↔ x ∈ F := iff_of_eq rfl

lemma is_pfilter : is_pfilter (F : set P) :=
F.dual.is_ideal

lemma nonempty : (F : set P).nonempty := F.dual.nonempty

lemma directed : directed_on (≥) (F : set P) := F.dual.directed

lemma mem_of_le {F : pfilter P} : x ≤ y → x ∈ F → y ∈ F := λ h, F.dual.lower h

/-- Two filters are equal when their underlying sets are equal. -/
@[ext] lemma ext (h : (s : set P) = t) : s = t :=
by { cases s, cases t, exact congr_arg _ (ideal.ext h) }

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (pfilter P) := partial_order.lift coe ext

@[trans] lemma mem_of_mem_of_le {F G : pfilter P} : x ∈ F → F ≤ G → x ∈ G :=
ideal.mem_of_mem_of_le

/-- The smallest filter containing a given element. -/
def principal (p : P) : pfilter P := ⟨ideal.principal p⟩

@[simp] lemma mem_def (x : P) (I : ideal Pᵒᵈ) :
  x ∈ (⟨I⟩ : pfilter P) ↔ order_dual.to_dual x ∈ I :=
iff.rfl

@[simp] lemma principal_le_iff {F : pfilter P} : principal x ≤ F ↔ x ∈ F :=
ideal.principal_le_iff

@[simp] lemma mem_principal : x ∈ principal y ↔ y ≤ x :=
ideal.mem_principal -- defeq abuse

lemma antitone_principal : antitone (principal : P → pfilter P) := by delta antitone; simp

lemma principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q :=
by simp

end preorder

section order_top
variables [preorder P] [order_top P] {F : pfilter P}

/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp] lemma top_mem : ⊤ ∈ F := ideal.bot_mem _

/-- There is a bottom filter when `P` has a top element. -/
instance : order_bot (pfilter P) :=
{ bot := ⟨⊥⟩,
  bot_le := λ F, (bot_le : ⊥ ≤ F.dual) }

end order_top

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [preorder P] [order_bot P] : order_top (pfilter P) :=
{ top := ⟨⊤⟩,
  le_top := λ F, (le_top : F.dual ≤ ⊤) }

section semilattice_inf
variables [semilattice_inf P] {x y : P} {F : pfilter P}

/-- A specific witness of `pfilter.directed` when `P` has meets. -/
lemma inf_mem (hx : x ∈ F) (hy : y ∈ F) : x ⊓ y ∈ F := ideal.sup_mem hx hy

@[simp] lemma inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
ideal.sup_mem_iff

end semilattice_inf

section complete_semilattice_Inf

variables [complete_semilattice_Inf P] {F : pfilter P}

lemma Inf_gc : galois_connection (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
λ x F, by { simp, refl }

/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
def Inf_gi : galois_coinsertion (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
{ choice := λ F _, Inf (id F : pfilter P),
  gc := Inf_gc,
  u_l_le := λ s, Inf_le $ mem_principal.2 $ le_refl s,
  choice_eq := λ _ _, rfl }

end complete_semilattice_Inf

end pfilter

end order


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import data.polynomial.eval
import linear_algebra.dimension

/-!
# Linear recurrence

Informally, a "linear recurrence" is an assertion of the form
`∀ n : ℕ, u (n + d) = a 0 * u n + a 1 * u (n+1) + ... + a (d-1) * u (n+d-1)`,
where `u` is a sequence, `d` is the *order* of the recurrence and the `a i`
are its *coefficients*.

In this file, we define the structure `linear_recurrence` so that
`linear_recurrence.mk d a` represents the above relation, and we call
a sequence `u` which verifies it a *solution* of the linear recurrence.

We prove a few basic lemmas about this concept, such as :

* the space of solutions is a submodule of `(ℕ → α)` (i.e a vector space if `α`
  is a field)
* the function that maps a solution `u` to its first `d` terms builds a `linear_equiv`
  between the solution space and `fin d → α`, aka `α ^ d`. As a consequence, two
  solutions are equal if and only if their first `d` terms are equals.
* a geometric sequence `q ^ n` is solution iff `q` is a root of a particular polynomial,
  which we call the *characteristic polynomial* of the recurrence

Of course, although we can inductively generate solutions (cf `mk_sol`), the
interesting part would be to determinate closed-forms for the solutions.
This is currently *not implemented*, as we are waiting for definition and
properties of eigenvalues and eigenvectors.

-/

noncomputable theory
open finset
open_locale big_operators

/-- A "linear recurrence relation" over a commutative semiring is given by its
  order `n` and `n` coefficients. -/
structure linear_recurrence (α : Type*) [comm_semiring α] := (order : ℕ) (coeffs : fin order → α)

instance (α : Type*) [comm_semiring α] : inhabited (linear_recurrence α) :=
⟨⟨0, default⟩⟩

namespace linear_recurrence

section comm_semiring

variables {α : Type*} [comm_semiring α] (E : linear_recurrence α)

/-- We say that a sequence `u` is solution of `linear_recurrence order coeffs` when we have
  `u (n + order) = ∑ i : fin order, coeffs i * u (n + i)` for any `n`. -/
def is_solution (u : ℕ → α) :=
  ∀ n, u (n + E.order) = ∑ i, E.coeffs i * u (n + i)

/-- A solution of a `linear_recurrence` which satisfies certain initial conditions.
  We will prove this is the only such solution. -/
def mk_sol (init : fin E.order → α) : ℕ → α
| n := if h : n < E.order then init ⟨n, h⟩ else
  ∑ k : fin E.order,
    have n - E.order + k < n :=
    begin
      rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h), tsub_lt_iff_left],
      { exact add_lt_add_right k.is_lt n },
      { convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h),
        simp only [zero_add] }
    end,
    E.coeffs k * mk_sol (n - E.order + k)

/-- `E.mk_sol` indeed gives solutions to `E`. -/
lemma is_sol_mk_sol (init : fin E.order → α) : E.is_solution (E.mk_sol init) :=
  λ n, by rw mk_sol; simp

/-- `E.mk_sol init`'s first `E.order` terms are `init`. -/
lemma mk_sol_eq_init (init : fin E.order → α) : ∀ n : fin E.order, E.mk_sol init n = init n :=
  λ n, by { rw mk_sol, simp only [n.is_lt, dif_pos, fin.mk_coe, fin.eta] }

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `∀ n, u n = E.mk_sol init n`. -/
lemma eq_mk_of_is_sol_of_eq_init {u : ℕ → α} {init : fin E.order → α}
  (h : E.is_solution u) (heq : ∀ n : fin E.order, u n = init n) :
  ∀ n, u n = E.mk_sol init n
| n := if h' : n < E.order
  then by rw mk_sol; simp only [h', dif_pos]; exact_mod_cast heq ⟨n, h'⟩
  else begin
    rw [mk_sol, ← tsub_add_cancel_of_le (le_of_not_lt h'), h (n-E.order)],
    simp [h'],
    congr' with k,
    exact have wf : n - E.order + k < n :=
      begin
        rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h'), tsub_lt_iff_left],
        { exact add_lt_add_right k.is_lt n },
        { convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h'),
          simp only [zero_add] }
      end,
      by rw eq_mk_of_is_sol_of_eq_init
  end

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `u = E.mk_sol init`. This proves that `E.mk_sol init` is the only solution
  of `E` whose first `E.order` values are given by `init`. -/
lemma eq_mk_of_is_sol_of_eq_init' {u : ℕ → α} {init : fin E.order → α}
  (h : E.is_solution u) (heq : ∀ n : fin E.order, u n = init n) : u = E.mk_sol init :=
  funext (E.eq_mk_of_is_sol_of_eq_init h heq)

/-- The space of solutions of `E`, as a `submodule` over `α` of the module `ℕ → α`. -/
def sol_space : submodule α (ℕ → α) :=
{ carrier := {u | E.is_solution u},
  zero_mem' := λ n, by simp,
  add_mem' := λ u v hu hv n, by simp [mul_add, sum_add_distrib, hu n, hv n],
  smul_mem' := λ a u hu n, by simp [hu n, mul_sum]; congr'; ext; ac_refl }

/-- Defining property of the solution space : `u` is a solution
  iff it belongs to the solution space. -/
lemma is_sol_iff_mem_sol_space (u : ℕ → α) : E.is_solution u ↔ u ∈ E.sol_space :=
  iff.rfl

/-- The function that maps a solution `u` of `E` to its first
  `E.order` terms as a `linear_equiv`. -/
def to_init :
  E.sol_space ≃ₗ[α] (fin E.order → α) :=
{ to_fun := λ u x, (u : ℕ → α) x,
  map_add' := λ u v, by { ext, simp },
  map_smul' := λ a u, by { ext, simp },
  inv_fun := λ u, ⟨E.mk_sol u, E.is_sol_mk_sol u⟩,
  left_inv := λ u, by ext n; symmetry; apply E.eq_mk_of_is_sol_of_eq_init u.2; intros k; refl,
  right_inv := λ u, function.funext_iff.mpr (λ n, E.mk_sol_eq_init u n) }

/-- Two solutions are equal iff they are equal on `range E.order`. -/
lemma sol_eq_of_eq_init (u v : ℕ → α) (hu : E.is_solution u) (hv : E.is_solution v) :
  u = v ↔ set.eq_on u v ↑(range E.order) :=
begin
  refine iff.intro (λ h x hx, h ▸ rfl) _,
  intro h,
  set u' : ↥(E.sol_space) := ⟨u, hu⟩,
  set v' : ↥(E.sol_space) := ⟨v, hv⟩,
  change u'.val = v'.val,
  suffices h' : u' = v', from h' ▸ rfl,
  rw [← E.to_init.to_equiv.apply_eq_iff_eq, linear_equiv.coe_to_equiv],
  ext x,
  exact_mod_cast h (mem_range.mpr x.2)
end

/-! `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. This operation is quite useful for determining closed-form
  solutions of `E`. -/

/-- `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. -/
def tuple_succ : (fin E.order → α) →ₗ[α] (fin E.order → α) :=
{ to_fun := λ X i, if h : (i : ℕ) + 1 < E.order then X ⟨i+1, h⟩ else (∑ i, E.coeffs i * X i),
  map_add' := λ x y,
    begin
      ext i,
      split_ifs ; simp [h, mul_add, sum_add_distrib],
    end,
  map_smul' := λ x y,
    begin
      ext i,
      split_ifs ; simp [h, mul_sum],
      exact sum_congr rfl (λ x _, by ac_refl),
    end }

end comm_semiring

section field

variables {α : Type*} [field α] (E : linear_recurrence α)

/-- The dimension of `E.sol_space` is `E.order`. -/
lemma sol_space_dim : module.rank α E.sol_space = E.order :=
@dim_fin_fun α _ E.order ▸ E.to_init.dim_eq

end field

section comm_ring

variables {α : Type*} [comm_ring α] (E : linear_recurrence α)

/-- The characteristic polynomial of `E` is
`X ^ E.order - ∑ i : fin E.order, (E.coeffs i) * X ^ i`. -/
def char_poly : polynomial α :=
  polynomial.monomial E.order 1 - (∑ i : fin E.order, polynomial.monomial i (E.coeffs i))

/-- The geometric sequence `q^n` is a solution of `E` iff
  `q` is a root of `E`'s characteristic polynomial. -/
lemma geom_sol_iff_root_char_poly (q : α) : E.is_solution (λ n, q^n) ↔ E.char_poly.is_root q :=
begin
  rw [char_poly, polynomial.is_root.def, polynomial.eval],
  simp only [polynomial.eval₂_finset_sum, one_mul,
              ring_hom.id_apply, polynomial.eval₂_monomial, polynomial.eval₂_sub],
  split,
  { intro h,
    simpa [sub_eq_zero] using h 0 },
  { intros h n,
    simp only [pow_add, sub_eq_zero.mp h, mul_sum],
    exact sum_congr rfl (λ _ _, by ring) }
end

end comm_ring

end linear_recurrence


/-
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, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.ideal.quotient
! leanprover-community/mathlib commit bd9851ca476957ea4549eb19b40e7b5ade9428cc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Fin
import Mathlib.Algebra.Ring.Prod
import Mathlib.LinearAlgebra.Quotient
import Mathlib.RingTheory.Congruence
import Mathlib.RingTheory.Ideal.Basic
import Mathlib.Tactic.FinCases

/-!
# Ideal quotients

This file defines ideal quotients as a special case of submodule quotients and proves some basic
results about these quotients.

See `Algebra.RingQuot` for quotients of non-commutative rings.

## Main definitions

 - `Ideal.Quotient`: the quotient of a commutative ring `R` by an ideal `I : Ideal R`

## Main results

 - `Ideal.quotientInfRingEquivPiQuotient`: the **Chinese Remainder Theorem**
-/

universe u v w

namespace Ideal

open Set
open BigOperators

variable {R : Type u} [CommRing R] (I : Ideal R) {a b : R}
variable {S : Type v}

-- Porting note: we need η for TC
set_option synthInstance.etaExperiment true

-- Note that at present `Ideal` means a left-ideal,
-- so this quotient is only useful in a commutative ring.
-- We should develop quotients by two-sided ideals as well.
/-- The quotient `R/I` of a ring `R` by an ideal `I`.

The ideal quotient of `I` is defined to equal the quotient of `I` as an `R`-submodule of `R`.
This definition is marked `reducible` so that typeclass instances can be shared between
`Ideal.Quotient I` and `Submodule.Quotient I`.
-/
@[reducible]
instance : HasQuotient R (Ideal R) :=
  Submodule.hasQuotient

namespace Quotient

variable {I} {x y : R}

instance hasOne (I : Ideal R) : One (R ⧸ I) :=
  ⟨Submodule.Quotient.mk 1⟩
#align ideal.quotient.has_one Ideal.Quotient.hasOne

/-- On `Ideal`s, `Submodule.quotientRel` is a ring congruence. -/
protected def ringCon (I : Ideal R) : RingCon R :=
  { QuotientAddGroup.con I.toAddSubgroup with
    mul' := fun {a₁ b₁ a₂ b₂} h₁ h₂ =>
      by
      rw [Submodule.quotientRel_r_def] at h₁ h₂⊢
      have F := I.add_mem (I.mul_mem_left a₂ h₁) (I.mul_mem_right b₁ h₂)
      have : a₁ * a₂ - b₁ * b₂ = a₂ * (a₁ - b₁) + (a₂ - b₂) * b₁ := by
        rw [mul_sub, sub_mul, sub_add_sub_cancel, mul_comm, mul_comm b₁]
      rw [← this] at F
      convert F }
#align ideal.quotient.ring_con Ideal.Quotient.ringCon

instance commRing (I : Ideal R) : CommRing (R ⧸ I) :=
  { @Submodule.Quotient.addCommGroup _ _ (id _) (id _) (id _) I,
    inferInstanceAs (CommRing (Quotient.ringCon I).Quotient) with }
#align ideal.quotient.comm_ring Ideal.Quotient.commRing

/-- The ring homomorphism from a ring `R` to a quotient ring `R/I`. -/
def mk (I : Ideal R) : R →+* R ⧸ I where
  toFun a := Submodule.Quotient.mk a
  map_zero' := rfl
  map_one' := rfl
  map_mul' _ _ := rfl
  map_add' _ _ := rfl
#align ideal.quotient.mk Ideal.Quotient.mk

/-- Two `RingHom`s from the quotient by an ideal are equal if their
compositions with `Ideal.Quotient.mk'` are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem ringHom_ext [NonAssocSemiring S] ⦃f g : R ⧸ I →+* S⦄ (h : f.comp (mk I) = g.comp (mk I)) :
    f = g :=
  RingHom.ext fun x => Quotient.inductionOn' x <| (RingHom.congr_fun h : _)
#align ideal.quotient.ring_hom_ext Ideal.Quotient.ringHom_ext

instance inhabited : Inhabited (R ⧸ I) :=
  ⟨mk I 37⟩
#align ideal.quotient.inhabited Ideal.Quotient.inhabited

protected theorem eq : mk I x = mk I y ↔ x - y ∈ I :=
  Submodule.Quotient.eq I
#align ideal.quotient.eq Ideal.Quotient.eq

@[simp]
theorem mk_eq_mk (x : R) : (Submodule.Quotient.mk x : R ⧸ I) = mk I x := rfl
#align ideal.quotient.mk_eq_mk Ideal.Quotient.mk_eq_mk

theorem eq_zero_iff_mem {I : Ideal R} : mk I a = 0 ↔ a ∈ I :=
  Submodule.Quotient.mk_eq_zero _
#align ideal.quotient.eq_zero_iff_mem Ideal.Quotient.eq_zero_iff_mem

-- Porting note: new theorem
theorem mk_eq_mk_iff_sub_mem (x y : R) : mk I x = mk I y ↔ x - y ∈ I := by
  rw [← eq_zero_iff_mem, map_sub, sub_eq_zero]

theorem zero_eq_one_iff {I : Ideal R} : (0 : R ⧸ I) = 1 ↔ I = ⊤ :=
  eq_comm.trans <| eq_zero_iff_mem.trans (eq_top_iff_one _).symm
#align ideal.quotient.zero_eq_one_iff Ideal.Quotient.zero_eq_one_iff

theorem zero_ne_one_iff {I : Ideal R} : (0 : R ⧸ I) ≠ 1 ↔ I ≠ ⊤ :=
  not_congr zero_eq_one_iff
#align ideal.quotient.zero_ne_one_iff Ideal.Quotient.zero_ne_one_iff

protected theorem nontrivial {I : Ideal R} (hI : I ≠ ⊤) : Nontrivial (R ⧸ I) :=
  ⟨⟨0, 1, zero_ne_one_iff.2 hI⟩⟩
#align ideal.quotient.nontrivial Ideal.Quotient.nontrivial

theorem subsingleton_iff {I : Ideal R} : Subsingleton (R ⧸ I) ↔ I = ⊤ := by
  rw [eq_top_iff_one, ← subsingleton_iff_zero_eq_one, eq_comm, ← (mk I).map_one,
    Quotient.eq_zero_iff_mem]
#align ideal.quotient.subsingleton_iff Ideal.Quotient.subsingleton_iff

instance : Unique (R ⧸ (⊤ : Ideal R)) :=
  ⟨⟨0⟩, by rintro ⟨x⟩; exact Quotient.eq_zero_iff_mem.mpr Submodule.mem_top⟩

theorem mk_surjective : Function.Surjective (mk I) := fun y =>
  Quotient.inductionOn' y fun x => Exists.intro x rfl
#align ideal.quotient.mk_surjective Ideal.Quotient.mk_surjective

instance : RingHomSurjective (mk I) :=
  ⟨mk_surjective⟩

/-- If `I` is an ideal of a commutative ring `R`, if `q : R → R/I` is the quotient map, and if
`s ⊆ R` is a subset, then `q⁻¹(q(s)) = ⋃ᵢ(i + s)`, the union running over all `i ∈ I`. -/
theorem quotient_ring_saturate (I : Ideal R) (s : Set R) :
    mk I ⁻¹' (mk I '' s) = ⋃ x : I, (fun y => x.1 + y) '' s := by
  ext x
  simp only [mem_preimage, mem_image, mem_unionᵢ, Ideal.Quotient.eq]
  exact
    ⟨fun ⟨a, a_in, h⟩ => ⟨⟨_, I.neg_mem h⟩, a, a_in, by simp⟩, fun ⟨⟨i, hi⟩, a, ha, Eq⟩ =>
      ⟨a, ha, by rw [← Eq, sub_add_eq_sub_sub_swap, sub_self, zero_sub]; exact I.neg_mem hi⟩⟩
#align ideal.quotient.quotient_ring_saturate Ideal.Quotient.quotient_ring_saturate

instance noZeroDivisors (I : Ideal R) [hI : I.IsPrime] : NoZeroDivisors (R ⧸ I) where
    eq_zero_or_eq_zero_of_mul_eq_zero {a b} := Quotient.inductionOn₂' a b fun {_ _} hab =>
      (hI.mem_or_mem (eq_zero_iff_mem.1 hab)).elim (Or.inl ∘ eq_zero_iff_mem.2)
        (Or.inr ∘ eq_zero_iff_mem.2)
#align ideal.quotient.no_zero_divisors Ideal.Quotient.noZeroDivisors

instance isDomain (I : Ideal R) [hI : I.IsPrime] : IsDomain (R ⧸ I) :=
  let _ := Quotient.nontrivial hI.1
  NoZeroDivisors.to_isDomain _
#align ideal.quotient.is_domain Ideal.Quotient.isDomain

theorem isDomain_iff_prime (I : Ideal R) : IsDomain (R ⧸ I) ↔ I.IsPrime := by
  refine' ⟨fun H => ⟨zero_ne_one_iff.1 _, fun {x y} h => _⟩, fun h => inferInstance⟩
  · haveI : Nontrivial (R ⧸ I) := ⟨H.2.1⟩
    exact zero_ne_one
  · simp only [← eq_zero_iff_mem, (mk I).map_mul] at h⊢
    haveI := @IsDomain.to_noZeroDivisors (R ⧸ I) _ H
    exact eq_zero_or_eq_zero_of_mul_eq_zero h
#align ideal.quotient.is_domain_iff_prime Ideal.Quotient.isDomain_iff_prime

theorem exists_inv {I : Ideal R} [hI : I.IsMaximal] :
    ∀ {a : R ⧸ I}, a ≠ 0 → ∃ b : R ⧸ I, a * b = 1 := by
  rintro ⟨a⟩ h
  rcases hI.exists_inv (mt eq_zero_iff_mem.2 h) with ⟨b, c, hc, abc⟩
  rw [mul_comm] at abc
  refine' ⟨mk _ b, Quot.sound _⟩
  --quot.sound hb
  rw [← eq_sub_iff_add_eq'] at abc
  rw [abc, ← neg_mem_iff (G := R) (H := I), neg_sub] at hc
  rw [Submodule.quotientRel_r_def]
  convert hc
#align ideal.quotient.exists_inv Ideal.Quotient.exists_inv

open Classical

/-- quotient by maximal ideal is a field. def rather than instance, since users will have
computable inverses in some applications.
See note [reducible non-instances]. -/
@[reducible]
protected noncomputable def field (I : Ideal R) [hI : I.IsMaximal] : Field (R ⧸ I) :=
  { Quotient.commRing I,
    Quotient.isDomain
      I with
    inv := fun a => if ha : a = 0 then 0 else Classical.choose (exists_inv ha)
    mul_inv_cancel := fun a (ha : a ≠ 0) =>
      show a * dite _ _ _ = _ by rw [dif_neg ha]; exact Classical.choose_spec (exists_inv ha)
    inv_zero := dif_pos rfl }
#align ideal.quotient.field Ideal.Quotient.field

/-- If the quotient by an ideal is a field, then the ideal is maximal. -/
theorem maximal_of_isField (I : Ideal R) (hqf : IsField (R ⧸ I)) : I.IsMaximal := by
  apply Ideal.isMaximal_iff.2
  constructor
  · intro h
    rcases hqf.exists_pair_ne with ⟨⟨x⟩, ⟨y⟩, hxy⟩
    exact hxy (Ideal.Quotient.eq.2 (mul_one (x - y) ▸ I.mul_mem_left _ h))
  · intro J x hIJ hxnI hxJ
    rcases hqf.mul_inv_cancel (mt Ideal.Quotient.eq_zero_iff_mem.1 hxnI) with ⟨⟨y⟩, hy⟩
    rw [← zero_add (1 : R), ← sub_self (x * y), sub_add]
    refine' J.sub_mem (J.mul_mem_right _ hxJ) (hIJ (Ideal.Quotient.eq.1 hy))
#align ideal.quotient.maximal_of_is_field Ideal.Quotient.maximal_of_isField

/-- The quotient of a ring by an ideal is a field iff the ideal is maximal. -/
theorem maximal_ideal_iff_isField_quotient (I : Ideal R) : I.IsMaximal ↔ IsField (R ⧸ I) :=
  ⟨fun h =>
    let _i := @Quotient.field _ _ I h
    Field.toIsField _,
    maximal_of_isField _⟩
#align ideal.quotient.maximal_ideal_iff_is_field_quotient Ideal.Quotient.maximal_ideal_iff_isField_quotient

variable [CommRing S]

/-- Given a ring homomorphism `f : R →+* S` sending all elements of an ideal to zero,
lift it to the quotient by this ideal. -/
def lift (I : Ideal R) (f : R →+* S) (H : ∀ a : R, a ∈ I → f a = 0) : R ⧸ I →+* S :=
  {
    QuotientAddGroup.lift I.toAddSubgroup f.toAddMonoidHom
      H with
    map_one' := f.map_one
    map_zero' := f.map_zero
    map_add' := fun a₁ a₂ => Quotient.inductionOn₂' a₁ a₂ f.map_add
    map_mul' := fun a₁ a₂ => Quotient.inductionOn₂' a₁ a₂ f.map_mul }
#align ideal.quotient.lift Ideal.Quotient.lift

@[simp]

theorem lift_surjective_of_surjective (I : Ideal R) {f : R →+* S} (H : ∀ a : R, a ∈ I → f a = 0)
    (hf : Function.Surjective f) : Function.Surjective (Ideal.Quotient.lift I f H) := by
  intro y
  obtain ⟨x, rfl⟩ := hf y
  use Ideal.Quotient.mk I x
  simp only [Ideal.Quotient.lift_mk]
#align ideal.quotient.lift_surjective_of_surjective Ideal.Quotient.lift_surjective_of_surjective

/-- The ring homomorphism from the quotient by a smaller ideal to the quotient by a larger ideal.

This is the `Ideal.Quotient` version of `Quot.Factor` -/
def factor (S T : Ideal R) (H : S ≤ T) : R ⧸ S →+* R ⧸ T :=
  Ideal.Quotient.lift S (mk T) fun _ hx => eq_zero_iff_mem.2 (H hx)
#align ideal.quotient.factor Ideal.Quotient.factor

@[simp]
theorem factor_mk (S T : Ideal R) (H : S ≤ T) (x : R) : factor S T H (mk S x) = mk T x :=
  rfl
#align ideal.quotient.factor_mk Ideal.Quotient.factor_mk

@[simp]
theorem factor_comp_mk (S T : Ideal R) (H : S ≤ T) : (factor S T H).comp (mk S) = mk T := by
  ext x
  rw [RingHom.comp_apply, factor_mk]
#align ideal.quotient.factor_comp_mk Ideal.Quotient.factor_comp_mk

end Quotient

/-- Quotienting by equal ideals gives equivalent rings.

See also `Submodule.quotEquivOfEq`.
-/
def quotEquivOfEq {R : Type _} [CommRing R] {I J : Ideal R} (h : I = J) : R ⧸ I ≃+* R ⧸ J :=
  { Submodule.quotEquivOfEq I J h with
    map_mul' := by
      rintro ⟨x⟩ ⟨y⟩
      rfl }
#align ideal.quot_equiv_of_eq Ideal.quotEquivOfEq

@[simp]
theorem quotEquivOfEq_mk {R : Type _} [CommRing R] {I J : Ideal R} (h : I = J) (x : R) :
    quotEquivOfEq h (Ideal.Quotient.mk I x) = Ideal.Quotient.mk J x :=
  rfl
#align ideal.quot_equiv_of_eq_mk Ideal.quotEquivOfEq_mk

@[simp]
theorem quotEquivOfEq_symm {R : Type _} [CommRing R] {I J : Ideal R} (h : I = J) :
    (Ideal.quotEquivOfEq h).symm = Ideal.quotEquivOfEq h.symm := by ext; rfl
#align ideal.quot_equiv_of_eq_symm Ideal.quotEquivOfEq_symm

section Pi

variable (ι : Type v)

/-- `R^n/I^n` is a `R/I`-module. -/
instance modulePi : Module (R ⧸ I) ((ι → R) ⧸ I.pi ι) where
  smul c m :=
    Quotient.liftOn₂' c m (fun r m => Submodule.Quotient.mk <| r • m) $ by
      intro c₁ m₁ c₂ m₂ hc hm
      apply Ideal.Quotient.eq.2
      rw [Submodule.quotientRel_r_def] at hc hm
      intro i
      exact I.mul_sub_mul_mem hc (hm i)
  one_smul := by
    rintro ⟨a⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr with i; exact one_mul (a i)
  mul_smul := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr 1; funext i; exact mul_assoc a b (c i)
  smul_add := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr with i; exact mul_add a (b i) (c i)
  smul_zero := by
    rintro ⟨a⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr with _; exact mul_zero a
  add_smul := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr with i; exact add_mul a b (c i)
  zero_smul := by
    rintro ⟨a⟩
    convert_to Ideal.Quotient.mk (I.pi ι) _ = Ideal.Quotient.mk (I.pi ι) _
    congr with i; exact zero_mul (a i)
#align ideal.module_pi Ideal.modulePi

set_option synthInstance.etaExperiment false in -- Porting note: needed, otherwise type times out
/-- `R^n/I^n` is isomorphic to `(R/I)^n` as an `R/I`-module. -/
noncomputable def piQuotEquiv : ((ι → R) ⧸ I.pi ι) ≃ₗ[R ⧸ I] ι → (R ⧸ I) := by
  refine' ⟨⟨⟨?toFun, _⟩, _⟩, ?invFun, _, _⟩
  case toFun => set_option synthInstance.etaExperiment true in -- Porting note: to get `Module R R`
    exact fun x ↦
      Quotient.liftOn' x (fun f i => Ideal.Quotient.mk I (f i)) fun a b hab =>
        funext fun i => (Submodule.Quotient.eq' _).2 (QuotientAddGroup.leftRel_apply.mp hab i)
  case invFun =>
    exact fun x ↦ Ideal.Quotient.mk (I.pi ι) fun i ↦ Quotient.out' (x i)
  · rintro ⟨_⟩ ⟨_⟩; rfl
  · rintro ⟨_⟩ ⟨_⟩; rfl
  · rintro ⟨x⟩
    exact Ideal.Quotient.eq.2 fun i => Ideal.Quotient.eq.1 (Quotient.out_eq' _)
  · intro x
    ext i
    obtain ⟨_, _⟩ := @Quot.exists_rep _ _ (x i)
    convert Quotient.out_eq' (x i)
#align ideal.pi_quot_equiv Ideal.piQuotEquiv

/-- If `f : R^n → R^m` is an `R`-linear map and `I ⊆ R` is an ideal, then the image of `I^n` is
    contained in `I^m`. -/
theorem map_pi {ι : Type _} [Finite ι] {ι' : Type w} (x : ι → R) (hi : ∀ i, x i ∈ I)
    (f : (ι → R) →ₗ[R] ι' → R) (i : ι') : f x i ∈ I := by
  classical
    cases nonempty_fintype ι
    rw [pi_eq_sum_univ x]
    simp only [Finset.sum_apply, smul_eq_mul, LinearMap.map_sum, Pi.smul_apply, LinearMap.map_smul]
    exact I.sum_mem fun j _ => I.mul_mem_right _ (hi j)
#align ideal.map_pi Ideal.map_pi

end Pi

section ChineseRemainder

variable {ι : Type v}

theorem exists_sub_one_mem_and_mem (s : Finset ι) {f : ι → Ideal R}
    (hf : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → f i ⊔ f j = ⊤) (i : ι) (his : i ∈ s) :
    ∃ r : R, r - 1 ∈ f i ∧ ∀ j ∈ s, j ≠ i → r ∈ f j := by
  have : ∀ j ∈ s, j ≠ i → ∃ r : R, ∃ _ : r - 1 ∈ f i, r ∈ f j := by
    intro j hjs hji
    specialize hf i his j hjs hji.symm
    rw [eq_top_iff_one, Submodule.mem_sup] at hf
    rcases hf with ⟨r, hri, s, hsj, hrs⟩
    refine' ⟨1 - r, _, _⟩
    · rw [sub_right_comm, sub_self, zero_sub]
      exact (f i).neg_mem hri
    · rw [← hrs, add_sub_cancel']
      exact hsj
  classical
    have : ∃ g : ι → R, (∀ j, g j - 1 ∈ f i) ∧ ∀ j ∈ s, j ≠ i → g j ∈ f j := by
      choose g hg1 hg2 using this
      refine' ⟨fun j => if H : j ∈ s ∧ j ≠ i then g j H.1 H.2 else 1, fun j => _, fun j => _⟩
      · dsimp only
        split_ifs with h
        · apply hg1
        rw [sub_self]
        exact (f i).zero_mem
      · intro hjs hji
        dsimp only
        rw [dif_pos]
        · apply hg2
        exact ⟨hjs, hji⟩
    rcases this with ⟨g, hgi, hgj⟩
    use ∏ x in s.erase i, g x
    constructor
    · rw [← Ideal.Quotient.mk_eq_mk_iff_sub_mem, map_one, map_prod]
      apply Finset.prod_eq_one
      intros
      rw [← RingHom.map_one, Ideal.Quotient.mk_eq_mk_iff_sub_mem]
      apply hgi
    · intro j hjs hji
      rw [← Quotient.eq_zero_iff_mem, map_prod]
      -- Porting note: Added the below line to help instance inferrence
      letI : CommMonoidWithZero (R ⧸ f j) := CommSemiring.toCommMonoidWithZero
      refine' Finset.prod_eq_zero (Finset.mem_erase_of_ne_of_mem hji hjs) _
      rw [Quotient.eq_zero_iff_mem]
      exact hgj j hjs hji
#align ideal.exists_sub_one_mem_and_mem Ideal.exists_sub_one_mem_and_mem

theorem exists_sub_mem [Finite ι] {f : ι → Ideal R} (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤)
    (g : ι → R) : ∃ r : R, ∀ i, r - g i ∈ f i := by
  cases nonempty_fintype ι
  have : ∃ φ : ι → R, (∀ i, φ i - 1 ∈ f i) ∧ ∀ i j, i ≠ j → φ i ∈ f j := by
    have := exists_sub_one_mem_and_mem (Finset.univ : Finset ι) fun i _ j _ hij => hf i j hij
    choose φ hφ using this
    exists fun i => φ i (Finset.mem_univ i)
    exact ⟨fun i => (hφ i _).1, fun i j hij => (hφ i _).2 j (Finset.mem_univ j) hij.symm⟩
  rcases this with ⟨φ, hφ1, hφ2⟩
  use ∑ i, g i * φ i
  intro i
  rw [← Quotient.mk_eq_mk_iff_sub_mem, map_sum]
  refine' Eq.trans (Finset.sum_eq_single i _ _) _
  · intro j _ hji
    rw [Quotient.eq_zero_iff_mem]
    exact (f i).mul_mem_left _ (hφ2 j i hji)
  · intro hi
    exact (hi <| Finset.mem_univ i).elim
  specialize hφ1 i
  rw [← Quotient.mk_eq_mk_iff_sub_mem, RingHom.map_one] at hφ1
  rw [RingHom.map_mul, hφ1, mul_one]
#align ideal.exists_sub_mem Ideal.exists_sub_mem

/-- The homomorphism from `R/(⋂ i, f i)` to `∏ i, (R / f i)` featured in the Chinese
  Remainder Theorem. It is bijective if the ideals `f i` are comaximal. -/
def quotientInfToPiQuotient (f : ι → Ideal R) : (R ⧸ ⨅ i, f i) →+* ∀ i, R ⧸ f i :=
  Quotient.lift (⨅ i, f i) (Pi.ringHom fun i : ι => (Quotient.mk (f i) : _)) fun r hr =>
    by
    rw [Submodule.mem_infᵢ] at hr
    ext i
    exact Quotient.eq_zero_iff_mem.2 (hr i)
#align ideal.quotient_inf_to_pi_quotient Ideal.quotientInfToPiQuotient

theorem quotientInfToPiQuotient_bijective [Finite ι] {f : ι → Ideal R}
    (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) : Function.Bijective (quotientInfToPiQuotient f) :=
  ⟨fun x y =>
    Quotient.inductionOn₂' x y fun r s hrs =>
      Quotient.eq.2 <|
        (Submodule.mem_infᵢ _).2 fun i =>
          Quotient.eq.1 <|
            show quotientInfToPiQuotient f (Quotient.mk'' r) i = _ by rw [hrs]; rfl,
    fun g =>
    let ⟨r, hr⟩ := exists_sub_mem hf fun i => Quotient.out' (g i)
    ⟨Quotient.mk _ r, funext fun i => Quotient.out_eq' (g i) ▸ Quotient.eq.2 (hr i)⟩⟩
#align ideal.quotient_inf_to_pi_quotient_bijective Ideal.quotientInfToPiQuotient_bijective

/-- Chinese Remainder Theorem. Eisenbud Ex.2.6. Similar to Atiyah-Macdonald 1.10 and Stacks 00DT -/
noncomputable def quotientInfRingEquivPiQuotient [Finite ι] (f : ι → Ideal R)
    (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) : (R ⧸ ⨅ i, f i) ≃+* ∀ i, R ⧸ f i :=
  { Equiv.ofBijective _ (quotientInfToPiQuotient_bijective hf), quotientInfToPiQuotient f with }
#align ideal.quotient_inf_ring_equiv_pi_quotient Ideal.quotientInfRingEquivPiQuotient

end ChineseRemainder

/-- **Chinese remainder theorem**, specialized to two ideals. -/
noncomputable def quotientInfEquivQuotientProd (I J : Ideal R) (coprime : I ⊔ J = ⊤) :
    R ⧸ I ⊓ J ≃+* (R ⧸ I) × R ⧸ J :=
  let f : Fin 2 → Ideal R := ![I, J]
  have hf : ∀ i j : Fin 2, i ≠ j → f i ⊔ f j = ⊤ := by
    intro i j h
    fin_cases i <;> fin_cases j <;> try contradiction
    · assumption
    · rwa [sup_comm]
  (Ideal.quotEquivOfEq (by simp [infᵢ, inf_comm])).trans <|
            (Ideal.quotientInfRingEquivPiQuotient f hf).trans <| RingEquiv.piFinTwo fun i => R ⧸ f i
#align ideal.quotient_inf_equiv_quotient_prod Ideal.quotientInfEquivQuotientProd

@[simp]
theorem quotientInfEquivQuotientProd_fst (I J : Ideal R) (coprime : I ⊔ J = ⊤) (x : R ⧸ I ⊓ J) :
    (quotientInfEquivQuotientProd I J coprime x).fst =
      Ideal.Quotient.factor (I ⊓ J) I inf_le_left x :=
  Quot.inductionOn x fun _ => rfl
#align ideal.quotient_inf_equiv_quotient_prod_fst Ideal.quotientInfEquivQuotientProd_fst

@[simp]
theorem quotientInfEquivQuotientProd_snd (I J : Ideal R) (coprime : I ⊔ J = ⊤) (x : R ⧸ I ⊓ J) :
    (quotientInfEquivQuotientProd I J coprime x).snd =
      Ideal.Quotient.factor (I ⊓ J) J inf_le_right x :=
  Quot.inductionOn x fun _ => rfl
#align ideal.quotient_inf_equiv_quotient_prod_snd Ideal.quotientInfEquivQuotientProd_snd

@[simp]
theorem fst_comp_quotientInfEquivQuotientProd (I J : Ideal R) (coprime : I ⊔ J = ⊤) :
    (RingHom.fst _ _).comp
        (quotientInfEquivQuotientProd I J coprime : R ⧸ I ⊓ J →+* (R ⧸ I) × R ⧸ J) =
      Ideal.Quotient.factor (I ⊓ J) I inf_le_left := by
  apply Quotient.ringHom_ext; ext; rfl
#align ideal.fst_comp_quotient_inf_equiv_quotient_prod Ideal.fst_comp_quotientInfEquivQuotientProd

@[simp]
theorem snd_comp_quotientInfEquivQuotientProd (I J : Ideal R) (coprime : I ⊔ J = ⊤) :
    (RingHom.snd _ _).comp
        (quotientInfEquivQuotientProd I J coprime : R ⧸ I ⊓ J →+* (R ⧸ I) × R ⧸ J) =
      Ideal.Quotient.factor (I ⊓ J) J inf_le_right := by
  apply Quotient.ringHom_ext; ext; rfl
#align ideal.snd_comp_quotient_inf_equiv_quotient_prod Ideal.snd_comp_quotientInfEquivQuotientProd

end Ideal


-- Exercise # 1

theorem and_com {p q : Prop} : p ∧ q ↔ q ∧ p :=
begin
  apply iff.intro,
  all_goals {intro h, constructor, {exact h.right}, {exact h.left}}
end

section
universe u

variables (α β : Type u)

example (α : Type u) (a b : α) (p : α → Prop) (h1 :a = b) (h2 : p a) : p b :=
  by {rw h1 at h2, assumption}

end

section

variables x y z : ℤ
example (x y z : ℕ) : x * (y + z) = x * y + x * z :=
  by {apply left_distrib}

end

section
variables (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
begin
  cases h with x pqx,
  constructor, rw and_comm, assumption
end

-- Exercise # 2
example (p q r : Prop) (hp : p) :
  (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
  by {split, any_goals {split}, all_goals { {left, assumption} <|> {right, left, assumption} <|> {right, right, assumption}}}

end


-- Asociativa_conmutativa_de_los_reales.lean
-- Asociativa conmutativa de los reales.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 22-agosto-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que los números reales tienen la siguente propiedad
--    (a * b) * c = b * (a * c)
-- ---------------------------------------------------------------------

import data.real.basic

variables a b c : ℝ

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

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

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

example : (a * b) * c = b * (a * c) :=
calc (a * b) * c
     = (b * a) * c : by rw mul_comm a b
 ... = b * (a * c) : by rw mul_assoc b a c

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

example : (a * b) * c = b * (a * c) :=
calc (a * b) * c
     = (b * a) * c : by ring
 ... = b * (a * c) : by ring

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

example : (a * b) * c = b * (a * c) :=
by ring


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kenny Lau.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.polynomial.default
import Mathlib.algebra.big_operators.basic
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Lagrange interpolation

## Main definitions

* `lagrange.basis s x` where `s : finset F` and `x : F`: the Lagrange basis polynomial
  that evaluates to `1` at `x` and `0` at other elements of `s`.
* `lagrange.interpolate s f` where `s : finset F` and `f : s → F`: the Lagrange interpolant
  that evaluates to `f x` at `x` for `x ∈ s`.

-/

namespace lagrange

/-- Lagrange basis polynomials that evaluate to 1 at `x` and 0 at other elements of `s`. -/
def basis {F : Type u} [DecidableEq F] [field F] (s : finset F) (x : F) : polynomial F :=
  finset.prod (finset.erase s x) fun (y : F) => coe_fn polynomial.C (x - y⁻¹) * (polynomial.X - coe_fn polynomial.C y)

@[simp] theorem basis_empty {F : Type u} [DecidableEq F] [field F] (x : F) : basis ∅ x = 1 :=
  rfl

@[simp] theorem eval_basis_self {F : Type u} [DecidableEq F] [field F] (s : finset F) (x : F) : polynomial.eval x (basis s x) = 1 := sorry

@[simp] theorem eval_basis_ne {F : Type u} [DecidableEq F] [field F] (s : finset F) (x : F) (y : F) (h1 : y ∈ s) (h2 : y ≠ x) : polynomial.eval y (basis s x) = 0 := sorry

theorem eval_basis {F : Type u} [DecidableEq F] [field F] (s : finset F) (x : F) (y : F) (h : y ∈ s) : polynomial.eval y (basis s x) = ite (y = x) 1 0 := sorry

@[simp] theorem nat_degree_basis {F : Type u} [DecidableEq F] [field F] (s : finset F) (x : F) (hx : x ∈ s) : polynomial.nat_degree (basis s x) = finset.card s - 1 := sorry

/-- Lagrange interpolation: given a finset `s` and a function `f : s → F`,
`interpolate s f` is the unique polynomial of degree `< s.card`
that takes value `f x` on all `x` in `s`. -/
def interpolate {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) : polynomial F :=
  finset.sum (finset.attach s) fun (x : Subtype fun (x : F) => x ∈ s) => coe_fn polynomial.C (f x) * basis s ↑x

@[simp] theorem interpolate_empty {F : Type u} [DecidableEq F] [field F] (f : ↥↑∅ → F) : interpolate ∅ f = 0 :=
  rfl

@[simp] theorem eval_interpolate {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) (x : F) (H : x ∈ s) : polynomial.eval x (interpolate s f) = f { val := x, property := H } := sorry

theorem degree_interpolate_lt {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) : polynomial.degree (interpolate s f) < ↑(finset.card s) := sorry

/-- Linear version of `interpolate`. -/
def linterpolate {F : Type u} [DecidableEq F] [field F] (s : finset F) : linear_map F (↥↑s → F) (polynomial F) :=
  linear_map.mk (interpolate s) sorry sorry

@[simp] theorem interpolate_add {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) (g : ↥↑s → F) : interpolate s (f + g) = interpolate s f + interpolate s g :=
  linear_map.map_add (linterpolate s) f g

@[simp] theorem interpolate_zero {F : Type u} [DecidableEq F] [field F] (s : finset F) : interpolate s 0 = 0 :=
  linear_map.map_zero (linterpolate s)

@[simp] theorem interpolate_neg {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) : interpolate s (-f) = -interpolate s f :=
  linear_map.map_neg (linterpolate s) f

@[simp] theorem interpolate_sub {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : ↥↑s → F) (g : ↥↑s → F) : interpolate s (f - g) = interpolate s f - interpolate s g :=
  linear_map.map_sub (linterpolate s) f g

@[simp] theorem interpolate_smul {F : Type u} [DecidableEq F] [field F] (s : finset F) (c : F) (f : ↥↑s → F) : interpolate s (c • f) = c • interpolate s f :=
  linear_map.map_smul (linterpolate s) c f

theorem eq_zero_of_eval_eq_zero {F' : Type u} [field F'] (s' : finset F') {f : polynomial F'} (hf1 : polynomial.degree f < ↑(finset.card s')) (hf2 : ∀ (x : F'), x ∈ s' → polynomial.eval x f = 0) : f = 0 := sorry

theorem eq_of_eval_eq {F' : Type u} [field F'] (s' : finset F') {f : polynomial F'} {g : polynomial F'} (hf : polynomial.degree f < ↑(finset.card s')) (hg : polynomial.degree g < ↑(finset.card s')) (hfg : ∀ (x : F'), x ∈ s' → polynomial.eval x f = polynomial.eval x g) : f = g := sorry

theorem eq_interpolate {F : Type u} [DecidableEq F] [field F] (s : finset F) (f : polynomial F) (hf : polynomial.degree f < ↑(finset.card s)) : (interpolate s fun (x : ↥↑s) => polynomial.eval (↑x) f) = f :=
  eq_of_eval_eq s (degree_interpolate_lt s fun (x : ↥↑s) => polynomial.eval (↑x) f) hf
    fun (x : F) (hx : x ∈ s) => eval_interpolate s (fun (x : ↥↑s) => polynomial.eval (↑x) f) x hx

/-- Lagrange interpolation induces isomorphism between functions from `s` and polynomials
of degree less than `s.card`. -/
def fun_equiv_degree_lt {F : Type u} [DecidableEq F] [field F] (s : finset F) : linear_equiv F (↥(polynomial.degree_lt F (finset.card s))) (↥↑s → F) :=
  linear_equiv.mk (fun (f : ↥(polynomial.degree_lt F (finset.card s))) (x : ↥↑s) => polynomial.eval (↑x) (subtype.val f))
    sorry sorry (fun (f : ↥↑s → F) => { val := interpolate s f, property := sorry }) sorry sorry


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import set_theory.continuum
import analysis.specific_limits.basic
import data.rat.denumerable
import data.set.intervals.image_preimage

/-!
# The cardinality of the reals

This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 𝔠`.

We show that `#ℝ ≤ 𝔠` by noting that every real number is determined by a Cauchy-sequence of the
form `ℕ → ℚ`, which has cardinality `𝔠`. To show that `#ℝ ≥ 𝔠` we define an injection from
`{0, 1} ^ ℕ` to `ℝ` with `f ↦ Σ n, f n * (1 / 3) ^ n`.

We conclude that all intervals with distinct endpoints have cardinality continuum.

## Main definitions

* `cardinal.cantor_function` is the function that sends `f` in `{0, 1} ^ ℕ` to `ℝ` by
  `f ↦ Σ' n, f n * (1 / 3) ^ n`

## Main statements

* `cardinal.mk_real : #ℝ = 𝔠`: the reals have cardinality continuum.
* `cardinal.not_countable_real`: the universal set of real numbers is not countable.
  We can use this same proof to show that all the other sets in this file are not countable.
* 8 lemmas of the form `mk_Ixy_real` for `x,y ∈ {i,o,c}` state that intervals on the reals
  have cardinality continuum.

## Notation

* `𝔠` : notation for `cardinal.continuum` in locale `cardinal`, defined in `set_theory.continuum`.

## Tags
continuum, cardinality, reals, cardinality of the reals
-/

open nat set
open_locale cardinal
noncomputable theory

namespace cardinal

variables {c : ℝ} {f g : ℕ → bool} {n : ℕ}

/-- The body of the sum in `cantor_function`.
`cantor_function_aux c f n = c ^ n` if `f n = tt`;
`cantor_function_aux c f n = 0` if `f n = ff`. -/
def cantor_function_aux (c : ℝ) (f : ℕ → bool) (n : ℕ) : ℝ := cond (f n) (c ^ n) 0

@[simp] lemma cantor_function_aux_tt (h : f n = tt) : cantor_function_aux c f n = c ^ n :=
by simp [cantor_function_aux, h]

@[simp] lemma cantor_function_aux_ff (h : f n = ff) : cantor_function_aux c f n = 0 :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_nonneg (h : 0 ≤ c) : 0 ≤ cantor_function_aux c f n :=
by { cases h' : f n; simp [h'], apply pow_nonneg h }

lemma cantor_function_aux_eq (h : f n = g n) :
  cantor_function_aux c f n = cantor_function_aux c g n :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_succ (f : ℕ → bool) :
  (λ n, cantor_function_aux c f (n + 1)) = λ n, c * cantor_function_aux c (λ n, f (n + 1)) n :=
by { ext n, cases h : f (n + 1); simp [h, pow_succ] }

lemma summable_cantor_function (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  summable (cantor_function_aux c f) :=
begin
  apply (summable_geometric_of_lt_1 h1 h2).summable_of_eq_zero_or_self,
  intro n, cases h : f n; simp [h]
end

/-- `cantor_function c (f : ℕ → bool)` is `Σ n, f n * c ^ n`, where `tt` is interpreted as `1` and
`ff` is interpreted as `0`. It is implemented using `cantor_function_aux`. -/
def cantor_function (c : ℝ) (f : ℕ → bool) : ℝ := ∑' n, cantor_function_aux c f n

lemma cantor_function_le (h1 : 0 ≤ c) (h2 : c < 1) (h3 : ∀ n, f n → g n) :
  cantor_function c f ≤ cantor_function c g :=
begin
  apply tsum_le_tsum _ (summable_cantor_function f h1 h2) (summable_cantor_function g h1 h2),
  intro n, cases h : f n, simp [h, cantor_function_aux_nonneg h1],
  replace h3 : g n = tt := h3 n h, simp [h, h3]
end

lemma cantor_function_succ (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  cantor_function c f = cond (f 0) 1 0 + c * cantor_function c (λ n, f (n+1)) :=
begin
  rw [cantor_function, tsum_eq_zero_add (summable_cantor_function f h1 h2)],
  rw [cantor_function_aux_succ, tsum_mul_left, cantor_function_aux, pow_zero],
  refl
end

/-- `cantor_function c` is strictly increasing with if `0 < c < 1/2`, if we endow `ℕ → bool` with a
lexicographic order. The lexicographic order doesn't exist for these infinitary products, so we
explicitly write out what it means. -/
lemma increasing_cantor_function (h1 : 0 < c) (h2 : c < 1 / 2) {n : ℕ} {f g : ℕ → bool}
  (hn : ∀(k < n), f k = g k) (fn : f n = ff) (gn : g n = tt) :
  cantor_function c f < cantor_function c g :=
begin
  have h3 : c < 1, { apply h2.trans, norm_num },
  induction n with n ih generalizing f g,
  { let f_max : ℕ → bool := λ n, nat.rec ff (λ _ _, tt) n,
    have hf_max : ∀n, f n → f_max n,
    { intros n hn, cases n, rw [fn] at hn, contradiction, apply rfl },
    let g_min : ℕ → bool := λ n, nat.rec tt (λ _ _, ff) n,
    have hg_min : ∀n, g_min n → g n,
    { intros n hn, cases n, rw [gn], apply rfl, contradiction },
    apply (cantor_function_le (le_of_lt h1) h3 hf_max).trans_lt,
    refine lt_of_lt_of_le _ (cantor_function_le (le_of_lt h1) h3 hg_min),
    have : c / (1 - c) < 1,
    { rw [div_lt_one, lt_sub_iff_add_lt],
      { convert add_lt_add h2 h2, norm_num },
      rwa sub_pos },
    convert this,
    { rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv,
          ←tsum_geometric_of_lt_1 (le_of_lt h1) h3],
      apply zero_add },
    { convert tsum_eq_single 0 _,
      { apply_instance },
      { intros n hn, cases n, contradiction, refl } } },
  rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3],
  rw [hn 0 $ zero_lt_succ n],
  apply add_lt_add_left, rw mul_lt_mul_left h1, exact ih (λ k hk, hn _ $ nat.succ_lt_succ hk) fn gn
end

/-- `cantor_function c` is injective if `0 < c < 1/2`. -/
lemma cantor_function_injective (h1 : 0 < c) (h2 : c < 1 / 2) :
  function.injective (cantor_function c) :=
begin
  intros f g hfg, classical, by_contra h, revert hfg,
  have : ∃n, f n ≠ g n,
  { rw [←not_forall], intro h', apply h, ext, apply h' },
  let n := nat.find this,
  have hn : ∀ (k : ℕ), k < n → f k = g k,
  { intros k hk, apply of_not_not, exact nat.find_min this hk },
  cases fn : f n,
  { apply ne_of_lt, refine increasing_cantor_function h1 h2 hn fn _,
    apply eq_tt_of_not_eq_ff, rw [←fn], apply ne.symm, exact nat.find_spec this },
  { apply ne_of_gt, refine increasing_cantor_function h1 h2 (λ k hk, (hn k hk).symm) _ fn,
    apply eq_ff_of_not_eq_tt, rw [←fn], apply ne.symm, exact nat.find_spec this }
end

/-- The cardinality of the reals, as a type. -/
lemma mk_real : #ℝ = 𝔠 :=
begin
  apply le_antisymm,
  { rw real.equiv_Cauchy.cardinal_eq,
    apply mk_quotient_le.trans, apply (mk_subtype_le _).trans_eq,
    rw [← power_def, mk_nat, mk_rat, omega_power_omega] },
  { convert mk_le_of_injective (cantor_function_injective _ _),
    rw [←power_def, mk_bool, mk_nat, two_power_omega], exact 1 / 3, norm_num, norm_num }
end

/-- The cardinality of the reals, as a set. -/
lemma mk_univ_real : #(set.univ : set ℝ) = 𝔠 :=
by rw [mk_univ, mk_real]

/-- **Non-Denumerability of the Continuum**: The reals are not countable. -/
lemma not_countable_real : ¬ countable (set.univ : set ℝ) :=
by { rw [← mk_set_le_omega, not_le, mk_univ_real], apply cantor }

/-- The cardinality of the interval (a, ∞). -/
lemma mk_Ioi_real (a : ℝ) : #(Ioi a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  rw [← not_lt], intro h,
  refine ne_of_lt _ mk_univ_real,
  have hu : Iio a ∪ {a} ∪ Ioi a = set.univ,
  { convert Iic_union_Ioi, exact Iio_union_right },
  rw ← hu,
  refine lt_of_le_of_lt (mk_union_le _ _) _,
  refine lt_of_le_of_lt (add_le_add_right (mk_union_le _ _) _) _,
  have h2 : (λ x, a + a - x) '' Ioi a = Iio a,
  { convert image_const_sub_Ioi _ _, simp },
  rw ← h2,
  refine add_lt_of_lt (cantor _).le _ h,
  refine add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _,
  rw mk_singleton,
  exact one_lt_omega.trans (cantor _)
end

/-- The cardinality of the interval [a, ∞). -/
lemma mk_Ici_real (a : ℝ) : #(Ici a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioi_real a ▸ mk_le_mk_of_subset Ioi_subset_Ici_self)

/-- The cardinality of the interval (-∞, a). -/
lemma mk_Iio_real (a : ℝ) : #(Iio a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h2 : (λ x, a + a - x) '' Iio a = Ioi a,
  { convert image_const_sub_Iio _ _, simp },
  exact mk_Ioi_real a ▸ h2 ▸ mk_image_le
end

/-- The cardinality of the interval (-∞, a]. -/
lemma mk_Iic_real (a : ℝ) : #(Iic a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Iio_real a ▸ mk_le_mk_of_subset Iio_subset_Iic_self)

/-- The cardinality of the interval (a, b). -/
lemma mk_Ioo_real {a b : ℝ} (h : a < b) : #(Ioo a b) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h1 : #((λ x, x - a) '' Ioo a b) ≤ #(Ioo a b) := mk_image_le,
  refine le_trans _ h1,
  rw [image_sub_const_Ioo, sub_self],
  replace h := sub_pos_of_lt h,
  have h2 : #(has_inv.inv '' Ioo 0 (b - a)) ≤ #(Ioo 0 (b - a)) := mk_image_le,
  refine le_trans _ h2,
  rw [image_inv_Ioo_0_left h, mk_Ioi_real]
end

/-- The cardinality of the interval [a, b). -/

/-- The cardinality of the interval [a, b]. -/
lemma mk_Icc_real {a b : ℝ} (h : a < b) : #(Icc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Icc_self)

/-- The cardinality of the interval (a, b]. -/
lemma mk_Ioc_real {a b : ℝ} (h : a < b) : #(Ioc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ioc_self)

end cardinal


import data.real tactic.norm_num data.nat.basic data.complex algebra.big_operators data.set.finite tactic.ring
open real nat
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable
universe u

lemma pow_inv' {α : Type u} [discrete_field α] (a : α) (n : ℕ) : (monoid.pow a n)⁻¹ = monoid.pow a⁻¹ n := begin
  induction n with n' hi,
  simp[monoid.pow],
  simp[monoid.pow],rw [mul_inv',mul_comm,hi],
end

lemma pow_abs {α : Type u} [decidable_linear_ordered_comm_ring α] (a : α) (n : ℕ) : monoid.pow (abs a) n = abs (monoid.pow a n) := begin
  induction n with n' hi,
  simp!, simp!,rw [hi,abs_mul],
end

lemma pow_incrs_of_gt_one {α : Type u}  [linear_ordered_semiring α] {x : α} {n m : ℕ} : 1 < x → n < m → monoid.pow x n < monoid.pow x m := begin
  assume x1 nm,revert n,
  induction m with m' hi,assume n nm,
  exact absurd nm (not_lt_of_ge (zero_le n)),assume n nm,
  cases m' with m'',
  rw eq_zero_of_le_zero (le_of_lt_succ nm),simpa!,
  cases n with n',
  simp!, simp! at hi,
  rw ←one_mul (1 : α),
  refine mul_lt_mul x1 (le_of_lt (@hi 0 dec_trivial)) (by norm_num) (le_of_lt(lt_trans (by norm_num) x1)),
  have hi' := @hi n' (lt_of_succ_lt_succ nm),
  suffices : x * monoid.pow x n' < x * monoid.pow x (succ m''),
    simpa [monoid.pow],
  refine mul_lt_mul' (le_refl x) hi' _ (lt_trans (by norm_num) x1),
  clear hi hi' nm m'',
  induction n' with n'' hi,
  simp!,norm_num,
  simp!,refine mul_nonneg (le_of_lt (lt_trans (by norm_num) x1)) hi,
end

lemma pow_dcrs_of_lt_one_of_pos {α : Type u}  [discrete_linear_ordered_field α] {x : α} {n m : ℕ} : x < 1 → 0 < x → n < m → monoid.pow x m < monoid.pow x n := begin
  assume x1 x0 nm,rw [←inv_lt_inv,pow_inv',pow_inv'],
  have x11 : 1 < x⁻¹ ,rw lt_inv,simpa,{norm_num},exact x0,
  refine pow_incrs_of_gt_one x11 nm,
  refine pow_pos x0 _,refine pow_pos x0 _,
end

lemma pow_unbounded_of_gt_one {x : ℝ} (y : ℝ) : 1 < x → ∃ n : ℕ, y < monoid.pow x n := begin
  assume x1,
  have : ∀ m : ℕ, (x - 1) * m < monoid.pow x m ∧ 1 ≤ monoid.pow x m,
    assume m, induction m with m' hi,
    simp,{norm_num},
    rw [←add_one,nat.cast_add,nat.cast_one], simp only [mul_add,monoid.pow],rw mul_one,
    have : x * monoid.pow x m' = monoid.pow x m' + (x - 1) * monoid.pow x m',
      rw add_comm,simp[mul_add,add_mul],
    rw this,split,
    refine add_lt_add_of_lt_of_le hi.left _,rw ←sub_pos at x1,
    have :=mul_le_mul (le_refl (x - 1)) hi.right (by norm_num) (le_of_lt x1),rwa mul_one at this,
    rw [←this, ←one_mul (1 : ℝ)],
    exact mul_le_mul (le_of_lt x1) hi.right (by norm_num) (le_of_lt (lt_trans (by norm_num) x1)),
  cases exists_nat_gt (y / (x - 1)) with n hn,
  existsi n,rw [div_lt_iff,mul_comm] at hn,
  exact lt_trans hn (this n).left,rwa sub_pos,
end

def sum_lt_nat {α : Type u} [has_add α] [has_zero α] (f : ℕ → α) : ℕ → α
| 0        := 0
| (succ n) := sum_lt_nat n + f n

lemma sum_nonneg {α : Type u} [linear_ordered_semiring α] {f : ℕ → α} (n : ℕ) : (∀ m : ℕ, 0 ≤ f m) → 0 ≤ sum_lt_nat f n := begin
  assume h,induction n with n' hi,
  simp!,simp!,exact add_nonneg (h n') hi,
end
#print mul_zero
lemma sum_lt_nat_mul {α : Type u} [semiring α] (f : ℕ → α) (a : α) (n : ℕ) : a * sum_lt_nat f n = sum_lt_nat (λ m, a * f m) n := begin
  induction n with n' hi,
  simp!,simp!,rw [mul_add,hi],
end

lemma sum_incrs_of_nonneg {α : Type u} [linear_ordered_semiring α] {f : ℕ → α} (i j : ℕ) : (∀ m ≥ i, 0 ≤ f m) → i ≤ j → sum_lt_nat f i ≤ sum_lt_nat f j := begin
  assume h ij,
  generalize hk : j - i = k,revert i j,
  induction k with k' hi,
  assume i j h ij hk,
  rw nat.sub_eq_zero_iff_le at hk, replace ij := le_antisymm hk ij,rw ij,
  assume i j h ij hk,have ik : i ≤ k' + i,rw ←zero_add i,refine add_le_add _ _,exact zero_le _,simp,
  have := hi i (k' + i) h ik (by rw nat.add_sub_cancel),
  rw [nat.sub_eq_iff_eq_add ij,succ_add] at hk,rw hk,simp!,
  refine le_trans this _,
  rw ←zero_add (sum_lt_nat f (k' + i)),refine add_le_add _ _,refine h _ ik,simp,
end

lemma sum_le_of_terms_le₁ {α : Type u} [linear_ordered_semiring α] {f g : ℕ → α} (i j : ℕ) : i ≤ j → (∀ m ≥ i, f m ≤ g m) → sum_lt_nat f j + sum_lt_nat g i ≤ sum_lt_nat g j + sum_lt_nat f i := begin
  generalize hk : j - i = k,revert i j,
  induction k with k' hi,assume i j hk ij h,
  rw nat.sub_eq_zero_iff_le at hk, replace ij := le_antisymm hk ij,rw [ij,add_comm],
  assume i j hk ij h,rw [nat.sub_eq_iff_eq_add ij,succ_add] at hk,rw hk,simp!,
  have ik : i ≤ k' + i,rw ←zero_add i,refine add_le_add _ _,exact zero_le _,simp,
  refine add_le_add _ _,
  refine h _ ik,
  have := hi i (k' + i) (by rw nat.add_sub_cancel) ik h,
  rwa [add_comm,add_comm _ (sum_lt_nat g (k' + i))],
end

lemma sum_le_of_terms_le₂ {α : Type u} [linear_ordered_ring α] {f g : ℕ → α} (i j : ℕ) : i ≤ j → (∀ m ≥ i, f m ≤ g m) → sum_lt_nat f j - sum_lt_nat f i ≤ sum_lt_nat g j - sum_lt_nat g i := begin
  assume ij h,
  have := sum_le_of_terms_le₁ i j ij h,rw sub_le_iff_le_add,rw add_comm,rw ←add_sub_assoc,rwa le_sub_iff_add_le,rwa add_comm (sum_lt_nat f i),
end
lemma geometric_series_l (n : ℕ) (x : ℝ) : x ≠ 1 → sum_lt_nat (monoid.pow x) n = (1 - monoid.pow x n) / (1 - x) := begin
  assume x1,have x1' : 1 + -x ≠ 0,assume h,rw [eq_comm, ←sub_eq_iff_eq_add] at h,simp at h,trivial,
  induction n with n' hi,
  simp!,rw eq_div_iff_mul_eq,simpa,
  simp!,rw hi,simp, rw [add_mul,div_mul_cancel _ x1',mul_add],ring,simp [x1'],
end

lemma geometric_series_cauchy (x : ℝ) : abs x < 1 → is_cau_seq (sum_lt_nat (monoid.pow x)):= begin
  assume x1, have : sum_lt_nat (monoid.pow x) = λ n,(1 - monoid.pow x n) / (1 - x),
    apply funext,assume n,refine geometric_series_l n x _ ,assume h, rw h at x1,exact absurd x1 (by norm_num),rw this,
  have absx : 0 < abs (1 - x),refine abs_pos_of_ne_zero _,assume h,rw sub_eq_zero_iff_eq at h,rw ←h at x1,
  have : ¬abs (1 : ℝ) < 1,norm_num,trivial,simp at absx,
  cases classical.em (x = 0),rw h,simp[monoid.pow],assume ε ε0,existsi 1,assume j j1,simpa!,
  cases j,exact absurd j1 dec_trivial,simpa!,
  have x2: 1 < (abs x)⁻¹,rw lt_inv,simpa,{norm_num},exact abs_pos_of_ne_zero h,
  assume ε ε0,cases pow_unbounded_of_gt_one (2 / (ε * abs (1 - x))) x2 with i hi,
  rw [←pow_inv',lt_inv] at hi,
  existsi i,assume j ji,rw [inv_eq_one_div,div_div_eq_mul_div,one_mul,lt_div_iff (by norm_num : (0 : ℝ) < 2)] at hi,
  rw [div_sub_div_same,abs_div,div_lt_iff],
  refine lt_of_le_of_lt _ hi,
  simp,
  refine le_trans (abs_add _ _) _,
  have : monoid.pow (abs x) i * 2 = monoid.pow (abs x) i + monoid.pow (abs x) i,ring,
  rw this,
  refine add_le_add _ _,rw ←pow_abs,
  rw [abs_neg,←pow_abs],
  cases lt_or_eq_of_le ji,
  refine le_of_lt (pow_dcrs_of_lt_one_of_pos x1 (abs_pos_of_ne_zero h) h_1),
  rw h_1,assumption,
  refine div_pos _ _,{norm_num},
  refine mul_pos ε0 _,simpa,
  refine pow_pos (abs_pos_of_ne_zero h) _,
end
lemma geometric_series_const (a x : ℝ) : abs x < 1 → is_cau_seq (sum_lt_nat (λ n, a * monoid.pow x n)) := begin
  assume x1 ε ε0,
  cases classical.em (a = 0),
  existsi 0,intros,rw [←sum_lt_nat_mul],induction j,simp!,assumption,rw h,simpa!,
  cases geometric_series_cauchy x x1 (ε / abs a) (div_pos ε0 (abs_pos_of_ne_zero h)) with i hi,
  existsi i,assume j ji,rw [←sum_lt_nat_mul,←sum_lt_nat_mul,←mul_sub,abs_mul,mul_comm,←lt_div_iff],exact hi j ji,exact abs_pos_of_ne_zero h,
end
lemma le_test (f g : ℕ → ℝ) (n : ℕ) : (∀ m ≥ n, abs (f m) ≤ g m) → is_cau_seq (sum_lt_nat g) → is_cau_seq (sum_lt_nat f) := begin
  assume hm hg ε ε0,cases hg (ε / 2) (div_pos ε0 (by norm_num)) with i hi,
  existsi max n i,
  assume j ji,
  have hi₁ := hi j (le_trans (le_max_right n i) ji),
  have hi₂ := hi (max n i) (le_max_right n i),
  have sub_le := abs_sub_le (sum_lt_nat g j) (sum_lt_nat g i) (sum_lt_nat g (max n i)),
  have := add_lt_add hi₁ hi₂,rw abs_sub (sum_lt_nat g (max n i)) at this,
  have ε2 : ε / 2 + ε / 2 = ε,rw [←add_div,(by ring : ε + ε = ε * 2),mul_div_cancel],{norm_num},
  rw ε2 at this,
  refine lt_of_le_of_lt _ this,
  refine le_trans _ sub_le,
  refine le_trans _ (le_abs_self _),
  have hmi : ∀ m : ℕ, m ≥ max n i → f m ≤ abs (f m),assume m h, exact le_abs_self _,
  have := sum_le_of_terms_le₂ (max n i) j ji hmi,
  refine abs_sub_le_iff.mpr _,split,
  refine le_trans this _,
  refine sum_le_of_terms_le₂ _ _ _ _,exact ji,
  assume m h,exact hm m (le_trans (le_max_left n i) h),
  have : sum_lt_nat f (max n i) - sum_lt_nat f j = -1 * sum_lt_nat f j - -1 * sum_lt_nat f (max n i),ring,
  rw [this,sum_lt_nat_mul,sum_lt_nat_mul],
  refine sum_le_of_terms_le₂ _ _ _ _,exact ji,
  assume m h,
  have := hm m (le_trans (le_max_left n i) h),
  refine le_trans _ this,simp,rw ←abs_neg, exact le_abs_self _,
end

lemma exp_series_cau (x : ℝ) : is_cau_seq (sum_lt_nat (λ m, monoid.pow x m / fact m)) := begin
  have nat_nonneg : ∀ n : ℕ, 0 ≤ (n : ℝ),assume n,rw [←nat.cast_zero,nat.cast_le],exact zero_le _,
  cases exists_nat_gt (abs x) with n nx,
  have xn : abs (x / n) < 1,rw [abs_div,div_lt_iff,@abs_of_nonneg _ _ (n : ℝ)],simpa,
  rw [←nat.cast_zero,(λ x y, by simp : ∀ x y : ℝ, x ≥ y ↔ y ≤ x ),nat.cast_le],exact zero_le _,
  refine abs_pos_of_ne_zero _,assume hn,rw hn at nx,exact not_lt_of_ge (abs_nonneg _) nx,
  refine le_test _ _ n _ (geometric_series_const (monoid.pow n n) (abs (x / ↑n)) _),
  assume m mn,
  generalize hk : m - n = k,
  have :  monoid.pow (abs (x / ↑n)) m = monoid.pow (abs x) m * (monoid.pow (n : ℝ) m)⁻¹,
    clear mn hk nx xn k,induction m with m hi,
    simp!,unfold monoid.pow,rw mul_inv',
    have : abs x * monoid.pow (abs x) m * ((monoid.pow ↑n m)⁻¹ * (↑n)⁻¹) = (abs x * (n : ℝ)⁻¹) * ((monoid.pow n m)⁻¹ * monoid.pow (abs x) m),ring,
    rw this,rw [←div_eq_mul_inv,hi,abs_div],have : abs (n : ℝ) = n,rw abs_of_nonneg,rw[← nat.cast_zero,(λ x y, by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x),nat.cast_le],exact zero_le _,
    rw this,ring,
  rw [this,mul_left_comm,abs_div,div_eq_mul_inv,←pow_abs],
  refine mul_le_mul _ _ _ _,trivial,clear this,
  rw nat.sub_eq_iff_eq_add at hk,rw hk,simp,clear xn,revert m n,
  induction k with k' hi,
  assume m n nx mn hk,
  simp,rw [mul_inv_cancel,inv_le],simp,
  clear hk mn nx m x,
  induction n with n hi,simp,
  unfold fact,rw[nat.cast_mul,abs_mul,←one_mul (1 : ℝ)],refine mul_le_mul _ _ _ _,
  rw [←nat.cast_one],refine le_trans _ (le_abs_self _),
  rw nat.cast_le,exact dec_trivial,exact hi,{norm_num},exact abs_nonneg _,
  refine lt_of_lt_of_le _ (le_abs_self _),rw [←nat.cast_zero,nat.cast_lt],exact fact_pos _,
  {norm_num},
  refine (ne_of_lt _).symm,
  refine pow_pos _ _,refine lt_of_le_of_lt _ nx,exact abs_nonneg _,
  assume m n nx mn hk,
  have : k' + n ≥ n,rw ←zero_add n,refine add_le_add _ _,exact zero_le _,rw zero_add,
  replace hi := hi (k' + n) n nx this rfl,
  rw add_succ,unfold fact monoid.pow,
  rw [mul_inv',nat.cast_mul,abs_mul,mul_inv',←mul_assoc],
  refine mul_le_mul _ _ _ _,assumption,
  rw inv_le_inv,refine le_trans _ (le_abs_self _),
  rw [nat.cast_le,←add_succ,←add_zero n],refine add_le_add _ _,
  simp,exact zero_le _,
  refine abs_pos_of_ne_zero _,
  rw [←nat.cast_zero,ne.def,nat.cast_inj],exact dec_trivial,
  refine lt_of_le_of_lt _ nx,exact abs_nonneg _,
  rw ←abs_inv,exact abs_nonneg _,
  refine mul_nonneg _ _,
  refine pow_nonneg _ _,rw [← nat.cast_zero,(λ x y,by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x), nat.cast_le],exact zero_le _,
  rw [(λ x y,by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x),inv_nonneg],
  refine pow_nonneg _ _,exact nat_nonneg _,
  exact mn,rw inv_nonneg,exact abs_nonneg _,rw pow_abs,exact abs_nonneg _,
  rwa abs_abs,
end

def exp (x : ℝ) : ℝ := lim ⟨(sum_lt_nat (λ m, monoid.pow x m / fact m)), exp_series_cau x⟩


import analysis.calculus.local_extr
import analysis.convex.slope
import analysis.convex.topology
import data.complex.is_R_or_C
import data.real.basic
import tactic.suggest
import tuto_lib
import data.nat.modeq
import tactic

-- whnf, weak head normal form
--
-- normal form
-- 1 + 2 is not normal form, since it can be evaluated to 3, thus
-- the normal form is 3 since there is nothing to be further evaluated
--
-- weak head normal form only evaluates the outermost structure,
-- sub-expressions may not have been evaluated
--
-- (Haskell example) (1 + 1, 2 + 2) is in whnf since the outermost
-- expression, the data constructor (,) cannot be further evaluated
--
-- https://stackoverflow.com/questions/6872898/what-is-weak-head-normal-form

example (a b c d : ℕ) : (a * d) * (b * c) = (d * a) * (c * b) :=
begin
  -- solutions to a = (b * c) = a * (c * b)

  -- rw mul_comm,             -- unhelpful, it doesn't rewrite what we want it to

  -- rw mul_comm b c,

  -- nth_rewrite 1 mul_comm,  -- another useful tactic

  -- solution to (a * d) * (b * c) = (d * a) * (c * b)

  conv
  begin                       -- | (a * d) * (b * c) = a * (c * b)
    to_lhs,                   -- | (a * d) * (b * c)
    congr,                    -- 2 goals : | a * d and | b * c
    rw mul_comm,              -- | d * a
    skip,                     -- | b * c
    rw mul_comm,              -- | c * b
  end,                        -- ⊢ (d * a) * (c * b) = (d * a) * (c * b)
end

example : (λ x : ℕ, 0 + x) = (λ x, x) :=
begin
  -- rw zero_add, -- unhelpful, can't get past λ binder

  -- by funext;
  -- rw zero_add,

  conv
  begin           -- | (λ (x : ℕ), 0 + x) = λ (x : ℕ), x
    to_lhs,       -- | λ (x : ℕ), 0 + x
    funext,       -- | 0 + x
    rw zero_add,  -- | x
  end
end

-- "Beware that a well known bug makes Lean printing: "find converter failed, pattern was not found"
-- when the tactics inside conversion mode fail, even if the pattern was actually found."
example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
begin
  conv in (b*c)  -- finds the first match to the pattern
  begin          -- | b * c
    rw mul_comm, -- | c * b
  end
end

-- one liner
example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
by conv in (b*c) { rw mul_comm }

-- wildcard
example (a b c : ℕ) : a + (b * c) = a + (c * b) :=
by conv in (_ * c) { rw mul_comm }

-- mul_comm on only 2nd and 3rd (b * c)
example (a b c : ℕ) : (b * c) * (b * c) * (b * c) = (b * c) * (c * b)  * (c * b):=
by conv { for (b * c) [2, 3] { rw mul_comm } }

---------------------------------------------------------

-- contrapose + push_neg = contrapose!

example (x y : ℝ) : x < y → y > x :=
begin
  -- contrapose,     -- take the contrapositive
  -- push_neg,       -- rewrite without negation
  contrapose!,
  simp,
end

-- calculation environment

example (a b c : ℕ) (H1 : a = b + 1) (H2 : b = c) : a = c + 1 :=
calc a = b + 1 : H1
...    = c + 1 : by rw H2

example (a b c : ℕ) (H1 : a = b + 1) (H2 : b = c) : a = c + 1 :=
begin
  calc a = b + 1 : H1
  ...    = c + 1 : _,
  { rw H2 }
end

-- Using operators other than equality

definition j : ℕ → ℕ → Prop := sorry
@[trans] theorem j_trans (a b c : ℕ) : j a b → j b c → j a c := sorry
infix `****`: 50 := j     -- left (by default) binding power of 50

example (a b c : ℕ) (H1 : a **** b) (H2 : b **** c) : a **** c :=
calc a **** b : H1
...    **** c : H2

-- Using more than one operator

theorem T2 (a b c d : ℕ)
  (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
begin
calc
  a     = b     : h1
    ... < b + 1 : nat.lt_succ_self b
    ... ≤ c + 1 : nat.succ_le_succ h2
    ... < d     : h3,
end

-- "The way this is done, Kevin thinks (can someone verify this?) is that Lean continually tries to amalgamate
-- the first two operators in the list, until there is only one left."
--
-- a = b < b + 1 ≤ c < d
-- a < b + 1 ≤ c + 1 < d
-- a < c + 1 < d
-- a < d

-- Lean recognizes that, given U op1 V and V op2 W, there may be some op3 (which could equal op1 or op2)
-- such that U op3 W
-- "Lean knows:
--
-- #check @trans_rel_right -- ∀ {α : Sort u_1} {a b c : α} (r : α → α → Prop), a = b → r b c → r a c
-- #check @trans_rel_left -- ∀ {α : Sort u_1} {a b c : α} (r : α → α → Prop), r a b → b = c → r a c
--
-- and (Kevin believes) uses them if one of the operators is an equality operator."
-- If neither are an equality operator, lean searches the database of theorems tagged [trans]
-- and applies them instead, for example

-- @[trans] lemma lt_of_lt_of_le [preorder α] : ∀ {a b c : α}, a < b → b ≤ c → a < c
-- @[trans] lemma lt_trans [preorder α] : ∀ {a b c : α}, a < b → b < c → a < c

-- the combination of two operators can be a new operator
definition r : ℕ → ℕ → Prop := sorry
definition s : ℕ → ℕ → Prop := sorry
definition t : ℕ → ℕ → Prop := sorry
@[trans] theorem rst_trans (a b c : ℕ) : r a b → s b c → t a c := sorry
infix `***`: 50 := r
infix `&&&` : 50 := s
infix `%%%` : 50 := t

example (a b c : ℕ) (H1 : a *** b) (H2 : b &&& c) : a %%% c :=
calc a *** b : H1
...    &&& c : H2

-- https://leanprover-community.github.io/extras/calc.html

--------------------------------------

-- operator precedence parsing:

-- left and right binding power ("infix" and "infixr"), "prefix"

-- "binding power" defines which operations take precedence, similar to PEMDAS
-- left and right binding power define operator associativity. 'a ~ b ~ c' can be interpreted as
-- '(a ~ b) ~ c' or 'a ~ (b ~ c)', left or right binding power respectively determines which way
-- it is interpreted

-- "When 'expression' is called, it is provided the 'rbp' - right binding power of the operator that called it.
-- It consumes tokens until it meets a token whose left binding power is equal or lower than rbp. Specifically,
-- it means that it collects all tokens that bind together before returning it to the operator that called it."

-- negation has a left binding power of 100, i.e. negation of a variable should never be what ends
-- the tokens binding together

-- According to Eli Bendersky's simplified parser example, '(' has a lbp of 0, i.e. it should stop anything

-- https://eli.thegreenplace.net/2010/01/02/top-down-operator-precedence-parsing

-- binding power in lean:

-- https://github.com/leanprover/lean/blob/master/library/init/core.lean

/- Logical operations and relations -/

reserve prefix `¬`:40
reserve prefix `~`:40
reserve infixr ` ∧ `:35
reserve infixr ` /\ `:35
reserve infixr ` \/ `:30
reserve infixr ` ∨ `:30
reserve infix ` <-> `:20
reserve infix ` ↔ `:20
reserve infix ` = `:50
reserve infix ` == `:50
reserve infix ` ≠ `:50
reserve infix ` ≈ `:50
reserve infix ` ~ `:50
reserve infix ` ≡ `:50
reserve infixl ` ⬝ `:75
reserve infixr ` ▸ `:75
reserve infixr ` ▹ `:75

/- types and type constructors -/

reserve infixr ` ⊕ `:30
reserve infixr ` × `:35

/- arithmetic operations -/

reserve infixl ` + `:65
reserve infixl ` - `:65
reserve infixl ` * `:70
reserve infixl ` / `:70
reserve infixl ` % `:70
reserve prefix `-`:100
reserve infixr ` ^ `:80

reserve infixr ` ∘ `:90                 -- input with \comp

reserve infix ` <= `:50
reserve infix ` ≤ `:50
reserve infix ` < `:50
reserve infix ` >= `:50
reserve infix ` ≥ `:50
reserve infix ` > `:50

/- boolean operations -/

reserve infixl ` && `:70
reserve infixl ` || `:65

/- set operations -/

reserve infix ` ∈ `:50
reserve infix ` ∉ `:50
reserve infixl ` ∩ `:70
reserve infixl ` ∪ `:65
reserve infix ` ⊆ `:50
reserve infix ` ⊇ `:50
reserve infix ` ⊂ `:50
reserve infix ` ⊃ `:50
reserve infix ` \ `:70

/- other symbols -/

reserve infix ` ∣ `:50
reserve infixl ` ++ `:65
reserve infixr ` :: `:67
reserve infixl `; `:1

--------------------------------------

-- some simplifications were made to make proving this easier, but perhaps the proof
-- can be modified in order to remove them.
theorem ivt_0 (f : ℝ → ℝ) {a b y : ℝ} (hab : a < b) (hfab : f a < f b) (hfc : continuous_on f (set.Icc a b)) (hy : y ∈ set.Ioo (f a) (f b)):
∃ (c : ℝ) (H : c ∈ set.Ioo a b), f(c) = y :=
begin
  -- define a set S which contains all x in [a, b] such that f(x) < k
  -- let c be the supremum of S
  -- c ≠ a since by continuity of f and with ε = (k - f(a)) / 2 there is
  -- some δ > 0 such that |a - x| < δ |f(x) - f(a)| < ε → f(x) < k, so since
  -- ∃ x > a such that f(x) < k → x ∈ S, then a cannot be the supremum.
  -- b cannot be the supremum for similar reasons, there is a neighborhood around b
  -- where all f(x) are greater than k, so some value less than b must be the supremum.
  -- Now, having c ∈ (a, b), use continuity to show that ∀ ε > 0 we have
  -- k - ε < f(c) < k + ε, since if not then c would not be the supremum of S.
  sorry,
end

-- theorem ivt (f : ℝ → ℝ) {a b : ℝ} (hab : a < b) (hfc : continuous_on f (set.Icc a b))

--------------------------------------

def continuous_at_pt (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

lemma is_sup_iff (A : set ℝ) (x : ℝ) :
(is_sup A x) ↔ (upper_bound A x ∧ ∃ u : ℕ → ℝ, seq_limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    {
      exact h.1,
    },
    { have : ∀ n : ℕ, ∃ a ∈ A, x - 1/(n+1) < a,
      { intros n,
        have : 1/(n+1 : ℝ) > 0,
          exact nat.one_div_pos_of_nat,
        exact lt_sup h _ (by linarith),
      },
      choose u hu using this,
      use u,
      split,
      { apply squeeze (limit_const_sub_inv_succ x) (limit_const x),
        { intros n,
          exact le_of_lt (hu n).2, },
        { intro n,
          exact h.1 _ (hu n).left, } },
      { intro n,
        exact (hu n).left },
  } },
  { rintro ⟨maj, u, limu, u_in⟩,
    split,
    { exact maj },
    { intros y ymaj,
      apply lim_le limu,
      intro n,
      apply ymaj,
      apply u_in },
  },
end

variables {f : ℝ → ℝ} {x₀ : ℝ} {u : ℕ → ℝ}

lemma seq_continuous_of_continuous (hf : continuous_at_pt f x₀)
  (hu : seq_limit u x₀) : seq_limit (f ∘ u) (f x₀) :=
begin
  intros ε ε_pos,
  unfold continuous_at_pt at hf,
  rcases hf ε ε_pos with ⟨δ, δ_pos, hδ⟩,
  cases hu δ δ_pos with N hN,
  use N,
  intros n hn,
  apply hδ,
  exact hN n hn,
end

lemma stupid {a b x : ℝ} (h : x ∈ set.Icc a b) (h' : x ≠ b) : x < b :=
lt_of_le_of_ne h.right h'

lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∃ N, ∀ n ≥ N, y ≤ u n) : y ≤ x :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases ineg with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left N N'),
  specialize hN' N₀ (le_max_right N N'),
  rw abs_le at hN,
  linarith,
end

theorem ivt (f : ℝ → ℝ) (a b c : ℝ) (hab : a ≤ b) (hf : ∀ (x ∈ set.Icc a b), continuous_at_pt f x) (h₀ : f a < c) (h₁ : f b > c) :
∃ x₀ ∈ set.Icc a b, f x₀ = c :=
begin
  let A := { x | x ∈ set.Icc a b ∧ f x < c},
  have ex_x₀ : ∃ x₀ ∈ set.Icc a b, is_sup A x₀,
  {
    apply sup_segment,
      use a,
      split,
        split, linarith, linarith,
      exact h₀,
    intros x hx,
    exact hx.left
  },
  rcases ex_x₀ with ⟨x₀, x₀_in, x₀_sup⟩,
  use [x₀, x₀_in],
  have : f x₀ ≤ c,
  {
    rw is_sup_iff at x₀_sup,
    rcases x₀_sup with ⟨maj_x₀, u, lim_u, u_dans⟩,
    have : seq_limit (f ∘ u) (f x₀),
      exact seq_continuous_of_continuous (hf x₀ x₀_in) lim_u,
    apply lim_le this,
    intros n,
    have : f (u n) < c,
      exact (u_dans n).right,
    linarith
  },
  have x₀_1: x₀ < b,
  {
    apply stupid x₀_in,
    intro h,
    rw ← h at h₁,
    linarith
  },
  have : f x₀ ≥ c,
  { have in_I : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ set.Icc a b,
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ b-x₀,
      {
        apply inv_succ_le_all,
        linarith,
      },
      cases this with N hN,
      use N,
      intros n hn,
      specialize hN n hn,
      have : 1/(n+1 : ℝ) > 0,
        exact nat.one_div_pos_of_nat,
      change a ≤ x₀ ∧ x₀ ≤ b at x₀_in,
      split ; linarith,
    },
    have not_in : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    {
      intros n hn,
      cases x₀_sup with x₀_maj _,
      specialize x₀_maj _ hn,
      have : 1/(n+1 : ℝ) > 0,
        from nat.one_div_pos_of_nat,
      linarith,
    },
    dsimp [A] at not_in,
    push_neg at not_in,
    have lim : seq_limit (λ n, f(x₀ + 1/(n+1))) (f x₀),
    { apply seq_continuous_of_continuous (hf x₀ x₀_in),
      apply limit_const_add_inv_succ },
    apply le_lim lim,
    cases in_I with N hN,
    use N,
    intros n hn,
    exact not_in n (hN n hn),
  },
  linarith,
end

-- Next Steps: Currently, this proof requires a ≤ b and f a < f b. Can this proof
-- be modified such that it works for a ≥ b and/or f a > f b? How about the trivial
-- case f a = c = f b?


import .love05_inductive_predicates_demo
import .love13_rational_and_real_numbers_demo

/-! # LoVe Exercise 13: Rational and Real Numbers -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Rationals

1.1. Prove the following lemma.

Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (hnum : fraction.num a = fraction.num b)
    (hdenom : fraction.denom a = fraction.denom b) :
  a = b :=
sorry

/-! 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` as an instance of `semigroup`.

Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

@[instance] def fraction.semigroup : semigroup fraction :=
{ mul_assoc :=
    sorry,
  ..fraction.has_mul }

/-! 1.3. Extending the `rat.has_mul` instance from the lecture, declare `rat` as
an instance of `semigroup`. -/

@[instance] def rat.semigroup : semigroup rat :=
{ mul_assoc :=
    sorry,
  ..rat.has_mul }

end LoVe