import algebra.comm_rings.basic
import algebra.comm_rings.ideals.basic
import algebra.comm_rings.ideals.instances
import algebra.comm_rings.ideals.identities
import algebra.comm_rings.instances.basic

namespace comm_ring

universes u v w

open set
open classical

def in_same_coset {R : Type u} [comm_ring R] (I: ideal R) : R → R → Prop := λ x y, x + -y ∈ I.body

notation x ` ≡ ` y ` mod ` I := in_same_coset I x y

lemma in_same_coset_refl {R : Type u} [comm_ring R] (I: ideal R) : ∀ x, x ≡ x mod I :=
begin
  intros x,
  have h : x + -x ∈ ↑I,
    rw minus_inverse,
    exact I.contains_zero,
  exact h,
end

lemma in_same_coset_symm {R : Type u} [comm_ring R] (I: ideal R) : symmetric (in_same_coset I) :=
begin
  intros x y hxy,
  have h : y + -x ∈ ↑I,
    rw ← minus_minus y,
    rw ← minus_dis,
    apply I.minus_closure,
    rw add_comm,
    exact hxy,
  exact h,
end

lemma in_same_coset_trans {R : Type u} [comm_ring R] (I: ideal R) : transitive (in_same_coset I) :=
begin
  intros x y z hxy hyz,
  have hrw : x + -z = (x + -y) + (y + -z),
    exact calc x + -z = (x + 0) + -z   : by rw add_zero x
                  ... =  (x + -y) + (y +- z) : by {rw [←minus_inverse, add_comm y (-y)], simp [add_assoc]},
  have h : x + -z ∈ ↑I,
    rw hrw,
    apply I.add_closure,
    exact hxy,
    exact hyz,
  exact h,
end

lemma mod_respects_add {R : Type u} [comm_ring R] {I: ideal R}
  : ∀ {x₁ x₂ y₁ y₂ : R} , (x₁ ≡ y₁ mod I) → (x₂ ≡ y₂ mod I) → ((x₁ + x₂) ≡ (y₁ + y₂) mod I) :=
begin
  intros x₁ x₂ y₁ y₂ h₁ h₂,
  have hrw : (x₁ + x₂) + -(y₁ + y₂) = (x₁ + -y₁) + (x₂ + -y₂),
    exact calc (x₁ + x₂) + -(y₁ + y₂) = (x₁ + x₂) + (-y₁ + -y₂) : by rw minus_dis
                                  ... =  x₁ + (x₂ + -y₁) + -y₂  : by simp [add_assoc]
                                  ... =  x₁ + (-y₁ + x₂) + -y₂  : by simp [add_comm]
                                  ... = (x₁ + -y₁) + (x₂ + -y₂) : by simp [add_assoc],
  have h : (x₁ + x₂) + -(y₁ + y₂) ∈ ↑I,
    rw hrw,
    apply I.add_closure,
    exact h₁,
    exact h₂,
  exact h,
end

lemma mod_respects_mul {R : Type u} [comm_ring R] {I: ideal R}
  : ∀ {x₁ x₂ y₁ y₂ : R} , (x₁ ≡ y₁ mod I) → (x₂ ≡ y₂ mod I) → ((x₁ * x₂) ≡ (y₁ * y₂) mod I) :=
begin
  intros x₁ x₂ y₁ y₂ h₁ h₂,
  have hrw : x₁ * x₂ + -(y₁ * y₂) = x₁ * (x₂ + -y₂) + (x₁ + -y₁) * y₂,
    symmetry,
    exact calc x₁ * (x₂ + -y₂) + (x₁ + -y₁) * y₂ = (x₁ * x₂ + x₁ * (-y₂)) + y₂ * (x₁ + -y₁)       : by simp [mul_dis,mul_comm]
                                             ... = (x₁ * x₂ + x₁ * (-y₂)) + (x₁ * y₂ + (-y₁) *y₂) : by simp [mul_dis,mul_comm]
                                             ... = x₁ * x₂ + (x₁ * (-y₂) + x₁ * y₂) + (-y₁) * y₂  : by simp [add_assoc]
                                             ... = x₁ * x₂ + (x₁ * (-y₂ + y₂)) + ((-y₁) *y₂)      : by simp [←mul_dis]
                                             ... = x₁ * x₂ + (-y₁) * y₂                           : by simp [add_comm,minus_inverse,add_zero,mul_zero]
                                             ... = x₁ * x₂ + - (y₁ * y₂)                          : by rw [←minus_mul],
  have h : x₁ * x₂ + -(y₁ * y₂) ∈ ↑I,
    rw hrw,
    apply I.add_closure,
    apply I.mul_absorb,
    exact h₂,
    rw mul_comm,
    apply I.mul_absorb,
    exact h₁,
  exact h,
end

lemma mod_respects_minus {R : Type u} [comm_ring R] {I: ideal R}
  : ∀ {x y : R}, (x ≡ y mod I) → (-x ≡ -y mod I) :=
begin
  intros x y hxy,
  have h : -x + (-(-y)) ∈ ↑I,
    rw ← minus_dis,
    apply I.minus_closure,
    exact hxy,
  exact h,
end

def quotient_ring_setiod (R : Type u) [l:comm_ring R] (I: ideal R) : setoid R :=
  {
    r := λ x y, x ≡ y mod I,
    iseqv := ⟨in_same_coset_refl I, in_same_coset_symm I, in_same_coset_trans I⟩,
  }

def quotient_ring (R :Type u) [comm_ring R] (I : ideal R) : Type u := quotient (comm_ring.quotient_ring_setiod R I)

infixr  `/ᵣ` : 25 := quotient_ring

def quotient_ring_mk {R : Type u} [comm_ring R] (I: ideal R) : R → R /ᵣ I := @quotient.mk R (quotient_ring_setiod R I)

infixr ` +ᵣ ` : 50 := λ x I , quotient_ring_mk I x

theorem quotient_ring_exists_rep {R: Type u} [comm_ring R] (I : ideal R) : ∀ q : R/ᵣ I, ∃ a : R, (a +ᵣ I) = q := @quotient.exists_rep R (quotient_ring_setiod R I)
theorem quotient_ring_sound {R: Type u} [comm_ring R] (I : ideal R) : ∀ {a b : R}, (a ≡ b mod I) → (a +ᵣ I) = (b +ᵣ I) := @quotient.sound R (quotient_ring_setiod R I)
theorem quotient_ring_exact {R: Type u} [comm_ring R] (I : ideal R) : ∀ {a b : R}, (a +ᵣ I) = (b +ᵣ I) → (a ≡ b mod I) := @quotient.exact R (quotient_ring_setiod R I)

def quotient_ring_one {R: Type u} [l:comm_ring R] (I:ideal R) : R /ᵣ I := l.one +ᵣ I

instance quotient_ring_has_one {R: Type u} [comm_ring R] (I:ideal R) : has_one (R /ᵣ I) := ⟨quotient_ring_one I⟩

theorem quotient_ring_concrete_char_of_one {R: Type u} [l:comm_ring R] (I:ideal R) : (l.one +ᵣ I) = 1 := rfl

def quotient_ring_zero {R: Type u} [l:comm_ring R] (I:ideal R) : R /ᵣ I := l.zero +ᵣ I

instance quotient_ring_has_zero {R: Type u} [comm_ring R] (I:ideal R) : has_zero (R /ᵣ I) := ⟨quotient_ring_zero I⟩

theorem quotient_ring_concrete_char_of_zero {R: Type u} [l:comm_ring R] (I:ideal R) : (l.zero +ᵣ I) = 0 := rfl

def quotient_ring_pre_add {R: Type u} [comm_ring R] (I:ideal R) : R → R → R /ᵣ I :=
  λ a b, (a + b) +ᵣ I

lemma quotient_ring_pre_add_lifts {R: Type u} [comm_ring R] (I:ideal R)
  : ∀ x₁ x₂ y₁ y₂, (x₁ ≡ y₁ mod I) → (x₂ ≡ y₂ mod I) →  quotient_ring_pre_add I x₁ x₂ = quotient_ring_pre_add I y₁ y₂ :=
begin
  intros x₁ x₂ y₁ y₂,
  intros h₁ h₂,
  apply quotient.sound,
  apply mod_respects_add,
  exact h₁,
  exact h₂,
end

def quotient_ring_add {R: Type u} [comm_ring R] (I : ideal R) : (R /ᵣ I) → (R /ᵣ I) → R /ᵣ I :=
begin
  apply quotient.lift₂,
  exact quotient_ring_pre_add_lifts I,
end

instance quotient_ring_has_add {R: Type u} [comm_ring R] (I : ideal R) : has_add (R/ᵣI) := ⟨quotient_ring_add I⟩

theorem quotient_ring_concrete_char_of_add {R: Type u} [comm_ring R] (I : ideal R) : ∀ a b : R, (a +ᵣ I) + (b +ᵣ I) = ((a + b) +ᵣ I) :=
begin
  intros a b,
  refl,
end

def quotient_ring_pre_mul {R: Type u} [comm_ring R] (I:ideal R) : R → R → R /ᵣ I :=
  λ a b, (a * b) +ᵣ I

lemma quotient_ring_pre_mul_lifts {R: Type u} [comm_ring R] (I:ideal R)
  : ∀ x₁ x₂ y₁ y₂, (x₁ ≡ y₁ mod I) → (x₂ ≡ y₂ mod I) →  quotient_ring_pre_mul I x₁ x₂ = quotient_ring_pre_mul I y₁ y₂ :=
begin
  intros x₁ x₂ y₁ y₂,
  intros h₁ h₂,
  apply quotient.sound,
  apply mod_respects_mul,
  exact h₁,
  exact h₂,
end

def quotient_ring.mul {R: Type u} [comm_ring R] (I : ideal R) : (R /ᵣ I) → (R /ᵣ I) → R /ᵣ I :=
begin
  apply quotient.lift₂,
  exact quotient_ring_pre_mul_lifts I,
end

instance quotient_ring_has_mul {R: Type u} [comm_ring R] (I : ideal R) : has_mul (R/ᵣI) := ⟨quotient_ring.mul I⟩

theorem quotient_ring_concrete_char_of_mul {R: Type u} [comm_ring R] (I : ideal R) : ∀ a b : R, (a +ᵣ I) * (b +ᵣ I) = ((a * b) +ᵣ I) :=
begin
  intros a b,
  refl,
end

def quotient_ring_pre_minus {R: Type u} [comm_ring R] (I : ideal R) : R → (R/ᵣI) :=
  λ x : R, (-x) +ᵣ I

lemma quotient_ring_pre_minus_lifts {R: Type u} [comm_ring R] (I : ideal R) : ∀ x y, (x ≡ y mod I) → quotient_ring_pre_minus I x = quotient_ring_pre_minus I y :=
begin
  intros x y hxy,
  apply quotient.sound,
  apply mod_respects_minus,
  exact hxy,
end

def quotient_ring_minus {R: Type u} [comm_ring R] (I : ideal R) : (R /ᵣ I) → (R /ᵣ I) :=
begin
  apply quotient.lift,
  exact quotient_ring_pre_minus_lifts I,
end

instance quotient_ring_has_neg {R: Type u} [comm_ring R] (I : ideal R) : has_neg (R/ᵣI) := ⟨quotient_ring_minus I⟩

theorem quotient_ring_concrete_char_of_minus {R: Type u} [comm_ring R] (I : ideal R) : ∀ a : R, -(a +ᵣ I)  = (-a +ᵣ I) :=
begin
  intros a,
  refl,
end

theorem quotient_ring_add_assoc {R: Type u} [comm_ring R] (I : ideal R) : ∀ q₁ q₂ q₃ : (R /ᵣ I), q₁ + (q₂ + q₃) = (q₁ + q₂) +q₃ :=
begin
  intros q₁ q₂ q₃,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  let r₃ := some (quotient_ring_exists_rep I q₃),
  have hr₃ : (r₃ +ᵣ I) = q₃ := some_spec (quotient_ring_exists_rep I q₃),
  rw [←hr₁,←hr₂,←hr₃],
  simp [quotient_ring_concrete_char_of_add],
  rw add_assoc,
end

theorem quotient_ring_add_comm {R: Type u} [comm_ring R] (I : ideal R) : ∀ q₁ q₂ : (R /ᵣ I), q₁ + q₂ = q₂ + q₁ :=
begin
  intros q₁ q₂,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  rw [←hr₁,←hr₂],
  simp [quotient_ring_concrete_char_of_add],
  rw add_comm,
end

theorem quotient_ring_mul_assoc {R: Type u} [comm_ring R] (I : ideal R) : ∀ q₁ q₂ q₃ : (R /ᵣ I), q₁ * (q₂ * q₃) = (q₁ * q₂) * q₃ :=
begin
  intros q₁ q₂ q₃,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  let r₃ := some (quotient_ring_exists_rep I q₃),
  have hr₃ : (r₃ +ᵣ I) = q₃ := some_spec (quotient_ring_exists_rep I q₃),
  rw [←hr₁,←hr₂,←hr₃],
  simp [quotient_ring_concrete_char_of_mul],
  rw mul_assoc,
end

theorem quotient_ring_mul_comm {R: Type u} [comm_ring R] (I : ideal R) : ∀ q₁ q₂ : (R /ᵣ I), q₁ * q₂ = q₂ * q₁ :=
begin
  intros q₁ q₂,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  rw [←hr₁,←hr₂],
  simp [quotient_ring_concrete_char_of_mul],
  rw mul_comm,
end

theorem quotient_ring_mul_dis {R: Type u} [comm_ring R] (I : ideal R) : ∀ q₁ q₂ q₃ : (R /ᵣ I), q₁ * (q₂ + q₃) = (q₁ * q₂) + (q₁ * q₃) :=
begin
  intros q₁ q₂ q₃,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  let r₃ := some (quotient_ring_exists_rep I q₃),
  have hr₃ : (r₃ +ᵣ I) = q₃ := some_spec (quotient_ring_exists_rep I q₃),
  rw [←hr₁,←hr₂,←hr₃],
  simp [quotient_ring_concrete_char_of_mul,quotient_ring_concrete_char_of_add],
  rw mul_dis,
end

theorem quotient_ring_mul_one {R: Type u} [comm_ring R] (I : ideal R) : ∀ q : (R /ᵣ I), q * 1 = q :=
begin
  intro q,
  let r := some (quotient_ring_exists_rep I q),
  have hr : (r +ᵣ I) = q := some_spec (quotient_ring_exists_rep I q),
  rw [←hr,←quotient_ring_concrete_char_of_one],
  simp [quotient_ring_concrete_char_of_mul],
  rw mul_one,
end

theorem quotient_ring_add_zero {R: Type u} [comm_ring R] (I : ideal R) : ∀ q : (R /ᵣ I), q + 0 = q :=
begin
  intro q,
  let r := some (quotient_ring_exists_rep I q),
  have hr : (r +ᵣ I) = q := some_spec (quotient_ring_exists_rep I q),
  rw [←hr,←quotient_ring_concrete_char_of_zero],
  simp [quotient_ring_concrete_char_of_add],
  rw add_zero,
end

theorem quotient_ring_minus_inverse {R: Type u} [comm_ring R] (I : ideal R) : ∀ q : (R /ᵣ I), q + -q = 0 :=
begin
  intro q,
  let r := some (quotient_ring_exists_rep I q),
  have hr : (r +ᵣ I) = q := some_spec (quotient_ring_exists_rep I q),
  rw [←hr,←quotient_ring_concrete_char_of_zero],
  simp [quotient_ring_concrete_char_of_add, quotient_ring_concrete_char_of_minus],
  rw minus_inverse,
end

instance quotient_ring_comm_ring {R: Type u} [comm_ring R] (I : ideal R) : comm_ring (R/ᵣI) :=
begin
  split,
  exact quotient_ring_add_assoc I,
  exact quotient_ring_add_comm I,
  exact quotient_ring_add_zero I,
  exact quotient_ring_minus_inverse I,
  exact quotient_ring_mul_assoc I,
  exact quotient_ring_mul_comm I,
  exact quotient_ring_mul_one I,
  exact quotient_ring_mul_dis I,
end

def quot_ring_hom {R: Type u} [comm_ring R] (I : ideal R) : R →ᵣ (R/ᵣI) :=
  {
    map := λ x, x +ᵣ I,
    prevs_mul := λ _ _, rfl,
    prevs_add := λ _ _, rfl,
    prevs_one := rfl,
  }

theorem quotient_ring_concrete_char_of_quot_map {R: Type u} [comm_ring R] (I : ideal R)
  : ∀ x : R, quot_ring_hom I x = (x +ᵣ I) :=
begin
  intro,
  refl,
end

theorem quotient_zero_implies_in_ideal {R: Type u} [comm_ring R] (I : ideal R)
  : ∀ {x : R} , (x +ᵣ I) = 0 → x ∈ I.body :=
begin
  intros x hx,
  rw [←add_zero x,← minus_zero_zero],
  have hrw : (x ≡ 0 mod I) = ((x +-0) ∈ I.body) := rfl,
  rw ← hrw,
  apply quotient_ring_exact,
  exact hx,
end

theorem in_ideal_implies_quotient_zero {R: Type u} [comm_ring R] (I : ideal R)
  : ∀ {x : R} , x ∈ I.body → (x +ᵣ I) = 0 :=
begin
  intros x hx,
  rw ← quotient_ring_concrete_char_of_zero,
  apply quotient_ring_sound,
  rw [←add_zero x,← minus_zero_zero] at hx,
  exact hx,
end

theorem quot_ring_hom_kernel {R: Type u} [l:comm_ring R] (I : ideal R) : ker (quot_ring_hom I) = I :=
begin
  apply ideal_equality,
  apply subset_antisymmetric,
  split,
  intros x hx,
  apply quotient_zero_implies_in_ideal,
  apply zero_ideal_is_just_zero,
  exact hx,
  intros x hx,
  have h₁: (x +ᵣ I) = 0,
    apply in_ideal_implies_quotient_zero,
    exact hx,
  have h: (x +ᵣ I) ∈ (zero_ideal (R/ᵣI)).body,
    rw h₁,
    exact linear_combination.empty_sum,
  exact h,
end

def quot_ring_universal_property {R: Type u} [lR:comm_ring R] (I : ideal R)
  : (Σ (Q : Type u) [lQ:comm_ring Q], (@ring_hom R Q lR lQ)) → Prop
  | ⟨Q,lQ,φ⟩ := (∀ r : R, r ∈ I.body → φ r = lQ.zero) ∧
    (∀ pair : (Σ (Q : Type u) [lQ:comm_ring Q], (@ring_hom R Q lR lQ)),
    (∀ r : R, r ∈ I.body → pair.2.2 r = pair.2.1.zero)
     → ∃! ψ : (@ring_hom Q pair.1 lQ pair.2.1) , pair.2.2 = (@ring_hom_comp R Q pair.1 lR lQ pair.2.1 ψ φ))

def quot_ring_app_lifts {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : ∀ r₁ r₂ : R, (r₁ ≡ r₂ mod I) →  φ r₁ =  φ r₂ :=
begin
  intros r₁ r₂ h₁₂,
  have hrw : r₁ = r₂ + (r₁ + -r₂),
    rw [add_comm r₁ (-r₂),add_assoc,minus_inverse],
    rw [add_comm,add_zero],
  rw hrw,
  have trv : φ.map = ⇑φ := rfl,
  rw [←trv,φ.prevs_add,trv, hφvan (r₁ + -r₂) h₁₂,add_zero],
end

def quot_ring_can_map {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : (R/ᵣI) → Q :=
begin
  apply quotient.lift,
  exact quot_ring_app_lifts I lQ φ hφvan,
end

theorem quotient_ring_concrete_char_of_can_map {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : ∀ x : R, quot_ring_can_map I lQ φ hφvan (x +ᵣ I) = φ x :=
begin
  intro,
  refl,
end

theorem quot_ring_can_map_prevs_add {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : ∀ q₁ q₂ : (R/ᵣI), quot_ring_can_map I lQ φ hφvan (q₁ + q₂) = (quot_ring_can_map I lQ φ hφvan q₁) + (quot_ring_can_map I lQ φ hφvan q₂) :=
begin
  intros q₁ q₂,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  rw [←hr₁,←hr₂],
  simp [quotient_ring_concrete_char_of_add I, quotient_ring_concrete_char_of_can_map],
  exact φ.prevs_add r₁ r₂,
end

theorem quot_ring_can_map_prevs_mul {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : ∀ q₁ q₂ : (R/ᵣI), quot_ring_can_map I lQ φ hφvan (q₁ * q₂) = (quot_ring_can_map I lQ φ hφvan q₁) * (quot_ring_can_map I lQ φ hφvan q₂) :=
begin
  intros q₁ q₂,
  let r₁ := some (quotient_ring_exists_rep I q₁),
  have hr₁ : (r₁ +ᵣ I) = q₁ := some_spec (quotient_ring_exists_rep I q₁),
  let r₂ := some (quotient_ring_exists_rep I q₂),
  have hr₂ : (r₂ +ᵣ I) = q₂ := some_spec (quotient_ring_exists_rep I q₂),
  rw [←hr₁,←hr₂],
  simp [quotient_ring_concrete_char_of_mul I, quotient_ring_concrete_char_of_can_map],
  exact φ.prevs_mul r₁ r₂,
end

theorem quot_ring_can_map_prevs_one {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) (lQ:comm_ring Q) (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : quot_ring_can_map I lQ φ hφvan 1 = 1 :=
begin
  simp [←quotient_ring_concrete_char_of_one,quotient_ring_concrete_char_of_can_map],
  exact φ.prevs_one,
end

def quot_ring_can_hom {R : Type u} {Q : Type v} [comm_ring R] (I : ideal R) [lQ:comm_ring Q] (φ : R →ᵣ Q) (hφvan : ∀ r : R , r ∈ I.body → φ r = 0)
  : ((R/ᵣI) →ᵣ Q) :=
  {
    map := quot_ring_can_map I lQ φ hφvan,
    prevs_add := quot_ring_can_map_prevs_add I lQ φ hφvan,
    prevs_mul := quot_ring_can_map_prevs_mul I lQ φ hφvan,
    prevs_one := quot_ring_can_map_prevs_one I lQ φ hφvan,
  }

theorem quotient_ring_satisfies_its_universal_property {R : Type u} [comm_ring R] (I :ideal R)
  : quot_ring_universal_property I ⟨(R/ᵣI),comm_ring.quotient_ring_comm_ring I,quot_ring_hom I⟩ :=
begin
  split,
  intros x hx,
  rw ← quot_ring_hom_kernel I at hx,
  apply zero_ideal_is_just_zero,
  exact hx,
  intros pair hpair,
  cases pair with Q rest,
  cases rest with lQ φ,
  resetI,
  existsi (quot_ring_can_hom I φ hpair),
  split,
  apply ring_hom_equality,
  refl,
  intros φ' hφ',
  apply ring_hom_equality_hack,
  have trv₁ : ∀ x : R , φ x = φ' (x +ᵣ I),
    simp at hφ',
    intros x,
    rw hφ',
    refl,
  apply funext,
  intro q,
  let r := some (quotient_ring_exists_rep I q),
  have hr : (r +ᵣ I) = q := some_spec (quotient_ring_exists_rep I q),
  rw ← hr,
  simp,
  rw ← trv₁ r,
  refl,
end

lemma quotient_ring_comp_hom_id {R Q: Type u} [comm_ring R] [lQ : comm_ring Q] {I : ideal R} {q : R →ᵣ Q}
  (Qup : quot_ring_universal_property I ⟨Q,lQ,q⟩) : ∀ φ : Q →ᵣ Q, q = (φ  ∘ᵣ q) → φ = idᵣ :=
begin
  intros φ hφ,
  cases Qup with vanish abNon,
  cases abNon ⟨Q,lQ,q⟩ vanish with ψ hψ,
  dsimp at ψ,
  dsimp at hψ,
  cases hψ with hψ ψup,
  have h₁ : φ = ψ,
    apply ψup,
    exact hφ,
  have h₂ : idᵣ = ψ,
    apply ψup,
    symmetry,
    exact id_hom_left_comp q,
  rw [h₁,h₂],
end

theorem universal_property_chars_quotient_ring {R Q Q': Type u} [lR:comm_ring R] [lQ : comm_ring Q]
  [lQ' : comm_ring Q'] {I : ideal R} (q : R →ᵣ Q) (q' : R →ᵣ Q')
  : quot_ring_universal_property I ⟨Q,lQ,q⟩ → quot_ring_universal_property I ⟨Q',lQ',q'⟩
  → ∃! ψ : Q →ᵣ Q', q' = (ψ ∘ᵣ q) ∧ (ring_isomorphism ψ) :=
begin
  intros upQ upQ',
  cases upQ with vanish abNon,
  cases upQ' with vanish' abNon',
  cases abNon ⟨Q',lQ',q'⟩ vanish' with ψ hψ,
  dsimp at ψ,
  dsimp at hψ,
  cases abNon' ⟨Q,lQ,q⟩ vanish with ψ' hψ',
  dsimp at ψ',
  dsimp at hψ',
  cases hψ with hψ ψup,
  cases hψ' with hψ' ψ'up,
  existsi ψ,
  split,
  split,
  exact hψ,
  existsi ψ',
  split,
  apply quotient_ring_comp_hom_id ⟨vanish,abNon⟩,
  rw [← ring_comp_assoc,← hψ,← hψ'],
  apply quotient_ring_comp_hom_id ⟨vanish',abNon'⟩,
  rw [← ring_comp_assoc,← hψ',← hψ],
  intros ψint hψint,
  apply ψup,
  exact and.left hψint,
end

theorem first_ring_isomorphism_thm {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂)
  : ∃ ψ : (R₁/ᵣ(ker φ)) →ᵣ Im φ, ring_isomorphism ψ :=
begin
  have hφvanish : ∀ r : R₁, r ∈ (ker φ).body → im_trival_hom_in φ r = 0,
    intros r hr,
    apply val_injective,
    apply zero_ideal_is_just_zero,
    exact hr,
  let ψ : (R₁/ᵣ(ker φ)) →ᵣ Im φ := quot_ring_can_hom (ker φ) (im_trival_hom_in φ) hφvanish,
  have trv : ∀ r : R₁, (ψ (r+ᵣ ((ker φ) : ideal R₁))).val = φ r,
    intro r,
    have subtrv₁ : ψ = quot_ring_can_hom (ker φ) (im_trival_hom_in φ) hφvanish := rfl,
    rw subtrv₁,
    simp,
    have subtrv₂ : quot_ring_can_hom (ker φ) (im_trival_hom_in φ) hφvanish (r +ᵣ ((ker φ) : ideal R₁))
                    = im_trival_hom_in φ r,
      simp,
      apply quotient_ring_concrete_char_of_can_map (ker φ),
      exact hφvanish,
    rw subtrv₂,
    refl,
  existsi ψ,
  apply bijective_ring_hom_ring_iso,
  split,
  apply zero_kernel_injective,
  apply ideal_equality,
  apply subset_antisymmetric,
  split,
  intros q hq,
  let r : R₁ := some (quotient_ring_exists_rep (ker φ) q),
  have hr : (r +ᵣ ((ker φ):ideal R₁) ) = q:= some_spec (quotient_ring_exists_rep (ker φ) q),
  simp at hr,
  rw ← hr,
  rw ← hr at hq,
  rw elements_of_kernel at hq,
  have hrkφ : φ r = 0,
    rw ← trv,
    simp,
    rw hq,
    refl,
  have hq0 : (r +ᵣ ((ker φ) :ideal R₁)) = 0,
    apply in_ideal_implies_quotient_zero,
    rw elements_of_kernel,
    assumption,
  simp at hq0,
  rw hq0,
  apply linear_combination.empty_sum,
  intros q hq,
  rw elements_of_kernel,
  rw zero_ideal_is_just_zero hq,
  apply ring_hom_preserves_zero ψ,
  intro y,
  cases y.property with x hx,
  existsi (x +ᵣ ((ker φ) : ideal R₁)),
  apply val_injective,
  rw trv,
  symmetry,
  assumption,
end

end comm_ring


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

import tactic

/-

# Bijections

Like finiteness, there are two ways to say that a function is bijective in Lean.
Furthermore, you will have heard of both of them, although it may well not
have occurred to you that these two ways were particularly different. It turns
out that one of them is more constructive than the other. Let's talk about
the nonconstructive (propositional) way of talking about bijections.

Let `X` and `Y` be types, and say `f : X → Y` is a function.

-/

variables (X Y : Type) (f : X → Y)

-- The `Prop`-valued way of saying that `f` is bijective is simply
-- to say literally that `f` is bijective, i.e., injective and surjective.

example : Prop := function.bijective f

-- Because `f` is a function type, a little Lean hack introduced recently
-- actually enables you to use dot notation for this.

example : Prop := f.bijective

-- The definition of `function.bijective f` is
-- `function.injective f ∧ function.surjective f`, and the definitions of
-- injective and surjective are what you think they are.

example : f.bijective ↔ f.injective ∧ f.surjective :=
begin
  refl
end

example : f.bijective ↔ (∀ x₁ x₂ : X, f x₁ = f x₂ → x₁ = x₂) ∧
  (∀ y : Y, ∃ x : X, f x = y) :=
begin
  refl
end

-- It's a theorem that `f` is bijective if and only if it has a two-sided
-- inverse. One way is not hard to prove: see if you can do it. Make
-- sure you know the maths proof first! If you can't do this then
-- please ask. There's lots of little Lean tricks which make this
-- question not too bad, but there are lots of little pitfalls too.

example : (∃ g : Y → X, f ∘ g = id ∧ g ∘ f = id) → f.bijective :=
begin
  sorry,
end

-- The other way is harder in Lean, unless you know about the `choose`
-- tactic. Given `f` and a proof that it's a bijection, how do you
-- prove the existence of a two-sided inverse `g`? You'll have to construct
-- `g`, and the `choose` tactic does this for you.
-- If `hfs` is a proof that `f` is surjective, try `choose g hg using hfs`.
example : f.bijective → ∃ g : Y → X, f ∘ g = id ∧ g ∘ f = id :=
begin
  sorry,
end


open Classical

variable (p q r s : Prop)

---------------------------------
-- Double negation elimination --
---------------------------------
example (h : ¬¬p) : p :=
  Or.elim (em p)
    (fun hp : p => hp)
    (fun hnp : ¬p => absurd hnp h)

------------------
-- Modus Ponens --
------------------
example : p → (p → q) → q :=
  fun (hp : p) (hpq : p → q) => hpq hp

----------------------
-- De Morgan's rules -
----------------------

-- ¬(p ∧ q) ↔ (¬p ∨ ¬q)
example : ¬(p ∧ q) ↔ (¬p ∨ ¬q):=
  Iff.intro
  (
    fun h : ¬(p ∧ q) =>
    Or.elim (em p)
    (
      fun hp : p =>
      Or.elim (em q)
      (
        fun hq : q =>
        have hpq : p ∧ q := And.intro hp hq
        show ¬p ∨ ¬q from absurd hpq h
      )
      (fun hnq : ¬q => show ¬p ∨ ¬q from Or.inr hnq)
    )
    (fun hnp : ¬p => Or.inl hnp)
  )
  (
    fun h : ¬p ∨ ¬q =>
    Or.elim h
    (
      fun hnp : ¬p =>
      fun hpq : p ∧ q =>
      absurd (And.left hpq) hnp
    )
    (
      fun hnq : ¬q =>
      fun hpq : p ∧ q =>
      absurd (And.right hpq) hnq
    )
  )

-- ¬(p ∨ q) ↔ (¬p ∧ ¬q)
example : ¬(p ∨ q) ↔ (¬p ∧ ¬q):=
  Iff.intro
  (
    fun h₀ : ¬(p ∨ q) =>
    have hnp : ¬p := fun hp : p => h₀ (Or.inl hp)
    have hnq : ¬q := fun hq : q => h₀ (Or.inr hq)
    show ¬p ∧ ¬q from And.intro hnp hnq
  )
  (
    fun h₀ : ¬p ∧ ¬q =>
    fun h₁ : p ∨ q =>
    Or.elim h₁
      (fun hp : p => absurd hp (And.left h₀))
      (fun hq : q => absurd hq (And.right h₀))
  )

------------------------------
-- Commutativity of ∧ and ∨ --
------------------------------

-- Commutativity of ∧
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
  (
    fun hpq : p ∧ q =>
    show q ∧ p from And.intro (And.right hpq) (And.left hpq)
  )
  (
    fun hqp : q ∧ p =>
    show p ∧ q from And.intro (And.right hqp) (And.left hqp)
  )

-- Commutativity of ∨
example : p ∨ q ↔ q ∨ p :=
  Iff.intro
  (
    fun hpq : p ∨ q =>
    Or.elim hpq (fun hp => Or.inr hp) (fun hq => Or.inl hq)
  )
  (
    fun hqp : q ∨ p =>
    Or.elim hqp (fun hq => Or.inr hq) (fun hp => Or.inl hp)
  )

------------------------------
-- Associativity of ∧ and ∨ --
------------------------------

-- Associativity of ∧
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
  (
    fun hpqr : (p ∧ q) ∧ r =>
    have hp : p := And.left (And.left hpqr)
    have hq : q := And.right (And.left hpqr)
    have hr : r := And.right hpqr
    show p ∧ (q ∧ r) from And.intro (And.left (And.left hpqr)) (And.intro hq hr)
  )
  (
    fun hpqr : p ∧ (q ∧ r) =>
    have hp : p := And.left hpqr
    have hq : q := And.left (And.right hpqr)
    have hr : r := And.right (And.right hpqr)
    show (p ∧ q) ∧ r from And.intro (And.intro hp hq) hr
  )

-- Associativity of ∨
example : (p ∨ q) ∨ r → p ∨ (q ∨ r) :=
  fun hpqr : (p ∨ q) ∨ r =>
  Or.elim hpqr
  (
    fun hpq : p ∨ q =>
    Or.elim hpq
    (
      fun hp : p =>
      show p ∨ (q ∨ r) from Or.inl hp
    )
    (
      fun hq : q =>
      have hqr : q ∨ r := Or.inl hq
      show p ∨ (q ∨ r) from Or.inr hqr
    )
  )
  (
    fun hr : r =>
    have hqr : q ∨ r := Or.inr hr
    show p ∨ (q ∨ r) from Or.inr hqr
  )

--------------------
-- Distributivity --
--------------------
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  Iff.intro
  (
    fun hpqr : p ∧ (q ∨ r) =>
    have hqr : q ∨ r := And.right hpqr
    Or.elim hqr
    (
      fun hq : q =>
      have hpq : p ∧ q := And.intro (And.left hpqr) hq
      show (p ∧ q) ∨ (p ∧ r) from Or.inl hpq
    )
    (
      fun hr : r =>
      have hpr : p ∧ r := And.intro (And.left hpqr) hr
      show (p ∧ q) ∨ (p ∧ r) from Or.inr hpr
    )
  )
  (
    fun h : (p ∧ q) ∨ (p ∧ r) =>
    Or.elim h
    (
      fun hpq : p ∧ q =>
      show p ∧ (q ∨ r) from And.intro (And.left hpq) (Or.inl (And.right hpq))
    )
    (
      fun hpr : p ∧ r =>
      show p ∧ (q ∨ r) from And.intro (And.left hpr) (Or.inr (And.right hpr))
    )
  )

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  Iff.intro
  (
    fun hpqr : p ∨ (q ∧ r) =>
    Or.elim hpqr
    (
      fun hp : p =>
      have hpq : p ∨ q := Or.inl hp
      have hpr : p ∨ r := Or.inl hp
      show (p ∨ q) ∧ (p ∨ r) from And.intro hpq hpr
    )
    (
      fun hqr : q ∧ r =>
      have hpq : p ∨ q := Or.inr (And.left hqr)
      have hpr : p ∨ r := Or.inr (And.right hqr)
      show (p ∨ q) ∧ (p ∨ r) from And.intro hpq hpr
    )
  )
  (
    fun h : (p ∨ q) ∧ (p ∨ r) =>
    have hpq : p ∨ q := And.left h
    have hpr : p ∨ r := And.right h
    Or.elim hpq
    (fun hp : p => Or.inl hp)
    (
      fun hq : q =>
      Or.elim hpr
      (fun hp : p => Or.inl hp)
      (
        fun hr : r =>
        have hqr : q ∧ r := And.intro hq hr
        show p ∨ (q ∧ r) from Or.inr hqr
      )
    )
  )

----------------------
-- Other properties --
----------------------
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
  (
    fun hpqr : p → (q → r) =>
    fun hpq : p ∧ q =>
    have hqr : q → r := hpqr (And.left hpq)
    show r from hqr (And.right hpq)
  )
  (
    fun hpqr : p ∧ q → r =>
    fun hp : p =>
    fun hq : q =>
    have hpq : p ∧ q := And.intro hp hq
    show r from hpqr hpq
  )

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  Iff.intro
  (
    fun h₀ : (p ∨ q) → r =>
    have h₁ : p → r := fun hp : p => h₀ (Or.inl hp)
    have h₂ : q → r := fun hq : q => h₀ (Or.inr hq)
    show (p → r) ∧ (q → r) from And.intro h₁ h₂
  )
  (
    fun h₀ : (p → r) ∧ (q → r) =>
    fun h₁ : p ∨ q =>
    Or.elim h₁
      (fun hp : p => (And.left h₀) hp)
      (fun hq : q => (And.right h₀) hq)
  )

example : ¬(p ∧ ¬p) :=
  fun h : p ∧ ¬p => absurd (And.left h) (And.right h)

example : p ∧ ¬q → ¬(p → q) :=
  fun h₀ : p ∧ ¬q =>
  fun h₁ : p → q =>
  absurd (h₁ (And.left h₀)) (And.right h₀)

example : ¬p → (p → q) :=
  fun h₀ : ¬p =>
  fun h₁ : p =>
  show q from absurd h₁ h₀

example : (¬p ∨ q) → (p → q) :=
  fun h₀ : ¬p ∨ q =>
  fun h₁ : p =>
  Or.elim h₀
    (fun h₂ : ¬p => show q from absurd h₁ h₂)
    (fun h₂ : q => show q from h₂)

example : p ∨ False ↔ p :=
  Iff.intro
  (
    fun h₀ : p ∨ False =>
    Or.elim h₀
      (fun hp : p => hp)
      (fun h₁ : False => show p from False.elim h₁)
  )
  (
    fun hp : p =>
    show p ∨ False from Or.inl hp
  )

example : p ∧ False ↔ False :=
  Iff.intro
  (
    fun h₀ : p ∧ False =>
    show False from And.right h₀
  )
  (
    fun h₀ : False =>
    show p ∧ False from False.elim h₀
  )

example : (p → q) → (¬q → ¬p) :=
  fun h₀ : p → q =>
  fun h₁ : ¬q =>
  fun h₂ : p =>
  absurd (h₀ h₂) h₁

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  fun h₀ : p → r ∨ s =>
  Or.elim (em p)
  (
    fun hp : p =>
    have hrs : r ∨ s := h₀ hp
    Or.elim hrs
    (
      fun hr : r =>
      have hpr : p → r := fun _ : p => hr
      show (p → r) ∨ (p → s) from Or.inl hpr
    )
    (
      fun hs : s =>
      have hps : p → s := fun _ : p => hs
      show (p → r) ∨ (p → s) from Or.inr hps
    )
  )
  (
    fun hnp : ¬p =>
    have hpr : p → r :=  fun hp : p => absurd hp hnp
    show (p → r) ∨ (p → s) from Or.inl hpr
  )

example : ¬(p → q) → p ∧ ¬q :=
  fun h₀ : ¬(p → q) =>
  Or.elim (em q)
  (
    fun hq : q =>
    have hpq : p → q := fun _ : p => hq
    show p ∧ ¬q from absurd hpq h₀
  )
  (
    fun hnq : ¬q =>
    Or.elim (em p)
    (
      fun hp : p =>
      show p ∧ ¬q from And.intro hp hnq
    )
    (
      fun hnp : ¬p =>
      have hpq : p → q := fun hp : p => absurd hp hnp
      show p ∧ ¬q from absurd hpq h₀
    )
  )


example: 1 + 1 = 2 := rfl

theorem add_zero  (n: Nat):   n + 0 = n                  := rfl
theorem add_one   (n: Nat):   n + 1 = n.succ             := rfl
theorem add_succ  (n k: Nat): n + k.succ = (n + k).succ  := rfl

theorem zero_add (n: Nat): 0 + n = n := by
  refine n.recOn rfl (λn (h: 0+n = n) => ?_)
  show (0+n).succ = n.succ;  rw[h]

theorem succ_add {n k: Nat}: n.succ + k = (n + k).succ := by
  refine k.recOn rfl (λk h => ?s)
  show (n.succ + k).succ = (n + k.succ).succ
  rw[h]; rfl

theorem add_assoc {n k p: Nat}: (n + k) + p = n + (k + p) := by
  refine p.recOn rfl (λp ih => ?s)
  calc
    (n + k) + p.succ = (n + k + p).succ   :=  rfl
                   _ = (n + (k + p)).succ :=  by rw[ih]

example {n k p: Nat}: (n + k) + p = n + (k + p) := by
  refine p.recOn rfl (λp ih => ?s)
  simp[add_succ, ih]

theorem add_comm {n k: Nat}: n + k = k + n :=
  n.recOn (by rw[zero_add]; rfl) (λn ih => by simp[add_succ, succ_add, ih])

theorem add_left_comm (n k p: Nat) : n + (k + p) = k + (n + p) :=
calc  n + (k + p)
    = (n + k) + p  := by rw[←add_assoc]
  _ = (k + n) + p  := by rw[@add_comm k]
  _ = k + (n + p)  := by rw[add_assoc]

example (a b c d e: Nat): (((a + b) + c) + d) + e = (c + ((b + e) + a)) + d :=
by simp[add_assoc, add_comm, add_left_comm]

-- Умножение

theorem mul_zero {n: Nat}:   n * 0 = 0               := rfl
theorem mul_succ {n k: Nat}: n * k.succ = n * k + n  := rfl
theorem mul_one {n: Nat}:    n * 1 = n :=
  by rw[mul_succ, add_comm]; rfl

theorem zero_mul {n:Nat}: 0 * n = 0 := by
  refine n.recOn rfl (λn h => ?_)
  calc  0 * n.succ
      = 0 * n + 0  := rfl
    _ = 0 + 0      := by simp[h]

theorem succ_mul {n k: Nat}: n.succ * k = n * k + k := by
  refine k.recOn rfl (λk h => ?_)
  calc  n.succ * k.succ
      = n.succ * k + n.succ  := by rw[mul_succ]
    _ = n * k + k + n.succ   := by simp [h]
    _ = n * k + n + k.succ   := by simp [add_assoc, add_comm, add_left_comm, add_succ]
    _ = n * k.succ + k.succ  := by simp [mul_succ]

theorem one_mul {n:Nat}: 1*n = n := by
  rw [succ_mul]
  show 0*n + n = n;  rw [zero_mul, zero_add]

theorem mul_left_distr {n k p: Nat}: n * (k + p) = n * k + n * p := by
  refine p.recOn rfl (λp h => ?_)
  show n * (k + p.succ) = n * k + n * p.succ
  simp [add_succ, mul_succ, h, add_assoc]

theorem mul_assoc {n k p: Nat}: (n * k) * p = n * (k * p) := by
  refine p.recOn rfl (λp h => ?_)
  show n * k * p.succ = n * (k * p.succ)
  simp [mul_succ, h, ←mul_left_distr]

theorem mul_comm {n k: Nat}: n * k = k * n := by
  refine k.recOn ?_ (λk h => ?_)
  show n * 0 = 0 * n;            rw [mul_zero, zero_mul]
  show n * k.succ = k.succ * n;  rw [mul_succ, h, ←succ_mul]

theorem mul_left_comm {n k p: Nat}: n * (k * p) = k * (n * p) :=
by rw [←mul_assoc, @mul_comm n, mul_assoc]

theorem mul_right_distr {n k p: Nat}: (n + k) * p = n * p + k * p :=
by simp [mul_comm, mul_left_distr]

-- Больше умножения и сложения

-- Сравнение

-- Вычитание и деление

#check Nat.sub
#check Nat.div
#check Nat.mod

-- Конечные числа

#check Fin
#check Subtype

-- Делимость

#check Nat.gcd

-- Целые числа

#check Int


/-
  The operator norm is the natural norm for linear operators between normed vector spaces. One can think of it as how much a map stretches unit vectors or as the smallest value that guarantees Cauchy-Schwarz (i.e. ∥L v∥ ≤ ∥L∥ * ∥v∥).

  The derivative of f : E → F is f' : E → continuous_linear_map E F.

  We need the operator norm both to define continuity for the definition of Caratheodory derivative and to take higher-order derivatives.
-/

-- TODO: We'd like op_norm to return an ennreal, but be able to restrict it to nonnegative reals when needed for a norm. Not sure how to do that yet. We can prove that the op_norm is finite for continuous/bounded linear maps. Should norm operate over nonnegative reals?

import differentiability.normed_space linear_algebra.linear_map_module analysis.ennreal order.complete_lattice

open lattice ennreal

noncomputable theory

universes u v w x

/- extended norm -/
-- TODO: of_real or of_nonneg_real?
def op_norm {k : Type u} {E : Type v} {F : Type w} [normed_field k] [normed_space k E] [normed_space k F] : linear_map E F → ennreal := λ L, Inf { M : ennreal | ∀ v : E, (of_nonneg_real ∥L v∥ norm_nonneg) ≤ M * (of_nonneg_real ∥v∥ norm_nonneg) }

section op_norm
variables {k : Type u} {E : Type v} {F : Type w}
variables [normed_field k] [normed_space k E] [normed_space k F]
variables {L M : linear_map E F}
include k

theorem op_norm_nonneg : op_norm L ≥ 0 := sorry

theorem op_norm_zero_iff_zero : op_norm L = 0 ↔ L = 0 := sorry

theorem op_norm_pos_homo : ∀ c (L : linear_map E F), op_norm (c•L) = (of_real ∥c∥) * op_norm L := sorry

theorem op_norm_triangle : op_norm (L + M) ≤ op_norm L + op_norm M := sorry

end op_norm

def op_dist {k : Type u} {E : Type v} {F : Type w} [normed_field k] [normed_space k E] [normed_space k F] : linear_map E F → linear_map E F → ennreal := λ L M, op_norm (L - M)

section op_dist
variables {k : Type u} {E : Type v} {F : Type w}
variables [normed_field k] [normed_space k E] [normed_space k F]
variables {L M N : linear_map E F}
include k

theorem op_dist_self : op_dist L L = 0 := sorry

theorem op_dist_eq_of_dist_eq_zero : op_dist L M = 0 → L = M := sorry

theorem op_dist_comm : op_dist L M = op_dist M L := sorry

theorem op_dist_triangle : op_dist L N ≤ op_dist L M + op_dist M N := sorry

end op_dist


import algebra.ring.basic
import data.real.basic
import data.nat.parity

open nat

--helper theorems
theorem num_odd_square_odd (a : ℕ): odd a ↔ odd (a^2) :=
begin
  split,
  {
    intro h,
    rw pow_two,
    have h₁ : odd (a * a) ↔ odd a ∧ odd a, from nat.odd_mul,
    rw h₁,
    split,
    {exact h},
    {exact h}
  },
  {
    rw pow_two,
    intro h,
    have h₁ : odd (a * a) ↔ (odd a ∧ odd a), from nat.odd_mul,
    have h₂ : odd a ∧ odd a, by {
      have h₃ : odd (a * a) → (odd a ∧ odd a), from iff.mp h₁,
      show odd a ∧ odd a, from h₃ (h)
    },
    have h₄ : odd a, from and.left h₂,
    exact h₄
  }
end

-- the same but for even numbers
-- such wow trick
theorem num_even_square_even (a : ℕ) : even a ↔ even (a^2) :=
begin
  repeat {rw nat.even_iff_not_odd},
  rw not_iff_not_of_iff,
  rw num_odd_square_odd,
end

-- another helper theorem for casing the even difference
theorem even_diff_same_parity (a b : ℕ) (h₀ : a ≥ b) :
  even (a - b) ↔ odd a ∧ odd b ∨ even a ∧ even b :=
begin
  split,
  {
    intro h,
    cases even_or_odd a with even_a odd_a,
    {
      have h₁ : even a ↔ even b, by {
        rw ←nat.even_sub,
        exact h,
        exact h₀,
      },
      have even_b : even b, by {rw ←h₁, exact even_a},
      have even_a_b : even a ∧ even b, by {
        exact ⟨even_a, even_b⟩,
      },
      exact or.inr even_a_b,
    },
    {
      have h₁ : odd a ↔ odd b, by {
        rw ←nat.even_sub',
        exact h,
        exact h₀,
      },
      have odd_b : odd b, by {rw ←h₁, exact odd_a},
      have odd_a_b : odd a ∧ odd b, by {
        exact ⟨odd_a, odd_b⟩,
      },
      exact or.inl odd_a_b,
    },
  },
  {
    intro h,
    cases h with odd_a_b even_a_b,
    {
      rw nat.even_sub',
      {
        cases odd_a_b with odd_a odd_b,
        exact iff_of_true odd_a odd_b,
      },
      {exact h₀},
    },
    {
      rw nat.even_sub,
      {
        cases even_a_b with even_a even_b,
        exact iff_of_true even_a even_b,
      },
      {exact h₀},
    }
  }
end

-- definitions of a square number
def is_square (n : ℕ) :=
  ∃ k : ℕ, k^2 = n

-- useful theorem to rewrite the definition
theorem is_square_def {n : ℕ} :
  is_square n ↔ ∃ k : ℕ, k^2 = n :=
begin
  refl
end

-- couple of cases to test how squaring of numbers works
-- case 1: 9 is a square, just using a substitution by definition
theorem nine_is_square : is_square 9 :=
begin
  rw is_square_def,
  use 3,
  ring
end

-- case 2: 10 is not a square, here we have to use parity contradictions
theorem ten_is_not_square : ¬ is_square 10 :=
begin
  rw is_square_def,
  by_contradiction,
  cases h with k h,
  have h₁ : even 10, by {rw even, use 5, ring},
  have h₂ : even k, by {rw num_even_square_even, rw h, exact h₁},
  unfold even at h₂,
  cases h₂ with m h₃,
  have h₄ : (2 * m) ^ 2 = 10, by {rw ←h₃, exact h},
  have h₅ : 4 * m ^ 2 = 10, by {rw ←h₄, ring},
  have h₆ : 2 * m ^ 2 = 5, by linarith,
  have h₇ : even (2 * m ^ 2), by {rw even, use (m ^ 2)},
  have h₈ : even 5, by {rw ←h₆, exact h₇},
  have h₉ : ¬ even 5, by {
    rw nat.even_iff_not_odd, rw decidable.not_not_iff,
    rw odd, use 2, ring
  },
  exact h₉ h₈,
end

-- trivial proof by substitution that 4 is not an odd number
theorem four_is_not_odd (n : ℕ) : ¬ odd 4 :=
begin
  rw nat.odd_iff_not_even,
  rw decidable.not_not_iff,
  rw even,
  use 2,
  ring,
end

-- solving the original task
theorem IMO1986P1
  (d : ℕ)
  (h₀ : d > 1)
  (h₁ : is_square (2 * d - 1))
  (h₂ : is_square (5 * d - 1))
  (h₃ : is_square (13 * d - 1)):
  false :=
begin
  -- step 1, proving that a is odd
  unfold is_square at h₁,
  cases h₁ with a ha,
  have a_odd : odd a, by {
    rw [num_odd_square_odd, ha, nat.odd_sub'],
    {
      have one_odd : odd 1, by {rw odd, use 0, ring},
      have even_2d : even (2 * d), by {rw even, use d},
      exact iff_of_true one_odd even_2d
    },
    {
      linarith
    },
  },
  -- step 2, proving that d is odd
  unfold odd at a_odd,
  cases a_odd with x hx,
  have d_odd : odd d, by {
    have h₄ : (2*x + 1)^2 = 2*d - 1, by {rw ←hx, exact ha},
    have h₅ : 4*x*x + 4*x + 1 = 2*d - 1, by linarith,
    have h₆ : 2*d - 1 = 4*x*x + 4*x + 1, by exact eq.symm h₅,
    have h₇ : 2*d - 1 + 1 = 4*x*x + 4*x + 1 + 1, by linarith,
    have h₈ : 2*d = 4*x*x + 4*x + 1 + 1, by {
      rw ←h₇, induction d, linarith, ring_nf,
    },
    have h₉ : 2*d = 4*x*x + 4*x + 2, by linarith,
    have hh₁ : 2*d = 2*(2*x*x + 2*x + 1), by linarith,
    have hh₂ : d = 2*x*x + 2*x + 1, by linarith,
    rw odd,
    use (x*x + x),
    rw [mul_add, ←mul_assoc],
    exact hh₂,
  },
  -- step 3, proving that b is even
  unfold odd at d_odd,
  cases d_odd with d' hd',
  unfold is_square at h₂,
  cases h₂ with b hb,
  have b_even : even b, by {
    rw [num_even_square_even, hb, hd', even],
    use (5*d' + 2),
    repeat {rw mul_add, rw ←mul_assoc},
    simp,
    refl,
  },
  -- step 4, proving that c is even
  unfold is_square at h₃,
  cases h₃ with c hc,
  have c_even : even c, by {
    rw [num_even_square_even, hc, hd', even],
    use (13*d' + 6),
    repeat {rw mul_add, rw ←mul_assoc},
    simp,
    refl,
  },
  -- step 5, introducing new parity facts about d
  unfold even at b_even,
  cases b_even with y hy,
  unfold even at c_even,
  cases c_even with z hz,
  have hdp : (z + y) * (z - y) = 2*d, by {
    have h₁ : c^2 - b^2 = (13*d-1) - (5*d-1), by rw [hc, hb],
    have h₂ : c^2 - b^2 = 8*d, by {
      rw h₁,
      have h₃ : 13 = 8 + 5, by refl,
      rw h₃,
      rw add_mul,
      have h₄ : (∃ t₁ : ℕ, t₁ = 8*d), by use (8*d),
      cases h₄ with t₁ ht₁,
      have h₅ : (∃ t₂ : ℕ, t₂ = 5*d), by use (5*d),
      cases h₅ with t₂ ht₂,
      repeat {rw [←ht₁, ←ht₂]},
      have h₆ : 1 ≤ t₂, by {rw ht₂, linarith},
      have h₇ : t₁ + t₂ - 1 = t₁ + (t₂ - 1), by {
        rw nat.add_sub_assoc,
        exact h₆,
      },
      rw h₇,
      have h₈ : (∃ t₃ : ℕ, t₃ = t₂ - 1), by use (t₂-1),
      cases h₈ with t₃ ht₃,
      repeat {rw ←ht₃},
      simp,
    },
    have h₃ : (2*z)^2 - (2*y)^2 = 8*d, by {rw [←hz, ←hy], exact h₂},
    have h₄ : 4*z*z - 4*y*y = 8*d, by {
      rw ←h₃,
      repeat {rw [pow_two, ←mul_assoc]},
      ring_nf,
    },
    have h₅ : 4*(z*z - y*y) = 4*(2*d), by {
      have eight_eq : 4 * 2 = 8, by refl,
      rw [←mul_assoc, eight_eq, ←h₄, mul_assoc, mul_assoc],
      have h₆ : (∃ t₁ : ℕ, t₁ = z * z), by use (z*z),
      cases h₆ with t₁ ht₁,
      have h₇ : (∃ t₂ : ℕ, t₂ = y * y), by use (y*y),
      cases h₇ with t₂ ht₂,
      rw [←ht₁, ←ht₂],
      rw nat.mul_sub_left_distrib,
    },
    have h₆ : z*z - y*y = 2*d, by linarith,
    rw [←h₆, nat.mul_self_sub_mul_self_eq],
  },
  -- step 6, proving the possible cases of new parity facts
  have h : odd (z + y) ∧ odd (z - y) ∨ even (z + y) ∧ even (z - y), by {
    rw ←even_diff_same_parity,
    {
      rw even,
      use y,
      have z_ge_y : z ≥ y, by {
        have y_2_le_z_2 : 2 * y ≤ 2 * z, by {
          rw [←hy, ←hz],
          have b2_le_c2 : b ^ 2 ≤ c ^ 2, by {
            rw [hb, hc],
            have d5_le_d13 : 5 * d ≤ 13 * d, by linarith,
            exact tsub_le_tsub_right d5_le_d13 1,
          },
          repeat {rw pow_two at b2_le_c2},
          exact nat.mul_self_le_mul_self_iff.mpr b2_le_c2,
        },
        linarith,
      },
      have h₁ : (∃ t₁ : ℕ, t₁ = z + y), by use (z + y),
      cases h₁ with t₁ ht₁,
      have h₂ : (∃ t₂ : ℕ, t₂ = z - y), by use (z - y),
      cases h₂ with t₂ ht₂,
      have h₃ : (∃ t₃ : ℕ, t₃ = 2 * y), by use (2 * y),
      cases h₃ with t₃ ht₃,
      rw [←ht₁, ←ht₂, ←ht₃],
      have h₁ : t₁ ≥ t₂, by {
        rw [ht₁, ht₂],
        norm_num,
        induction y,
        {ring_nf},
        {
          ring_nf,
          exact le_self_add,
        },
      },
      rw nat.sub_eq_iff_eq_add,
      {
        rw [ht₂, ←nat.add_sub_assoc],
        {
          rw nat.sub_add_comm,
          {
            rw [ht₃, ←nat.one_mul y, ←mul_assoc, ←nat.mul_sub_right_distrib],
            norm_num,
            rw ht₁,
            exact add_comm z y,
          },
          {rw ht₃, linarith},
        },
        {exact z_ge_y},
      },
      {exact h₁},
    },
    {
      have ht : z - y + y ≤ z + y + y, by {simp, linarith},
      exact (add_le_add_iff_right y).mp ht,
    },
  },
  cases h with mul_odd mul_even,
  {
    cases mul_odd with h₁ h₂,
    have even_2d : even (2 * d), by {rw even, use d},
    have odd_2d : odd (2 * d), by {rw ←hdp, exact odd.mul h₁ h₂},
    have not_odd_2d : ¬odd (2 * d), by {rw ←even_iff_not_odd, exact even_2d},
    exact not_odd_2d odd_2d,
  },
  {
    cases mul_even with h₁ h₂,
    unfold even at h₁ h₂,
    cases h₁ with t₁ ht₁,
    cases h₂ with t₂ ht₂,
    have d_odd : odd d, by {rw odd, use d', exact hd'},
    have d_even : even d, by {
      have h₁ : (2 * t₁) * (2 * t₂) = 2 * d, by {rw [←ht₁, ←ht₂], exact hdp},
      have h₂ : 2 * t₁ * t₂ = d, by linarith,
      rw even,
      use (t₁ * t₂),
      rw ←h₂,
      exact mul_assoc 2 t₁ t₂,
    },
    have d_not_odd : ¬odd d, by {rw ←even_iff_not_odd, exact d_even},
    exact d_not_odd d_odd,
  },
end


import Mathlib.Tactic.Basic
import Basics.FunctionDefinitions
/-!
## Structured Constructs

The previous section presented the main commands for writing structured proofs: `fun`, `have`,
and `show`. We now review the components of structured proofs more systematically.

**Lemma or Hypothesis**

The simplest structured proof, apart from `sorry`, is the name of a lemma or hypothesis. If we have
-/
lemma two_add_two_eq_four :
  2 + 2 = 4 :=
-- . . .
/-!
then the lemma name `two_add_two_eq_four` can be used as a proof of `2 + 2 = 4` later.
For example:
-/
lemma this_time_with_feelings :
  2 + 2 = 4 :=
two_add_two_eq_four

/-!
We can pass arguments to lemmas to instantiate ∀-quantifiers and discharge assumptions. Suppose the
lemma `add_comm (m n : ℕ) : add m n = add n m` is available, and suppose we want to prove its instance
`add 0 n = add n 0`. This can be achieved neatly using the name of the lemma and two arguments:
-/
axiom add_comm (m n : ℕ) : add m n = add n m

lemma add_comm_zero_left (n : ℕ) :
  add 0 n = add n 0 :=
  add_comm 0 n
/-!
This has the same effect as the tactical proof `by exact add_comm 0 n`, but is more concise. The `exact`
tactic can be seen as the inverse of `by`. Why enter tactic mode if only to leave it immediately?

Like with `exact` and `apply`, the lemma or hypothesis’s statement is matched with the current goal up
to computation. This gives some flexibility.

**fun**

```lean
fun (names₁ [: type₁]) . . . (namesₙ [: typeₙ]) =>
```

A lambda `fun` moves ∀-quantified variables from the goal’s target to the local
context. It can be seen as a structured version of the `intros` tactic.

**have**

```lean
have name : proposition := proof
```
The `have` command lets us state and prove an intermediate lemma, which may refer to names
introduced previously. The proof can be tactical or structured. Generally, we tend to use structured
proofs to sketch the main argument and resort to tactical proofs for proving subgoals or
uninteresting intermediate steps. Another kind of mixture arises when we pass arguments to lemma
names. For example, given `hab : a → b` and `ha : a`, the tactic `exact hab ha` will prove the goal
`⊢ b`. Here, `hab ha` is a proof term nested inside a tactic. So the earlier line
`have hb : b := hab ha` can also be written using a tactic as `have hb : b := by exact hab ha`.

**let**
```
let name [: type] := term
```
Just as with a normal `def` the `let` command introduces a new local definition. It can be used to
name a complex object that occurs several times in the proof afterwards. It is similar to `have` but
is designed for computable data, not proofs. Expanding or introducing a let corresponds to
ζ-conversion (Section 2.2).

**show**
```lean
show proposition from proof
show proposition by tactic proof
```
The `show` command lets us repeat the goal to prove, which can be useful as documentation. It also
allows us to rephrase the goal in a syntactically equal form up to computation. Instead of the
syntax `show proposition from proof`, we can simply write `proof` if we do not want to repeat the goal
and do not need to rephrase it. The proof can also be tactical if you write `show proposition by ...`

-/


/-
Translate a few missing lemmas to the subgroup API.
Author: Adrián Doña Mateo

These were contributed to mathlib in
[#6974](https://github.com/leanprover-community/mathlib/pull/6974/).

There are no name clashes in this file because the local version of the library is has not
been upgraded to this PR.
-/

import group_theory.subgroup

-- These lemmas were added to src/group_theory/subgroup.lean

variables {G N : Type*} [group G] [group N]

namespace subgroup
open set

@[to_additive]
lemma comap_mono {f : G →* N} {K K' : subgroup N} : K ≤ K' → comap f K ≤ comap f K' :=
preimage_mono

@[to_additive]
lemma map_mono {f : G →* N} {K K' : subgroup G} : K ≤ K' → map f K ≤ map f K' :=
image_subset _

open monoid_hom

variables {H : Type*} [group H]

@[to_additive]
lemma map_le_range (f : G →* H) (K : subgroup G) : map f K ≤ f.range :=
(range_eq_map f).symm ▸ map_mono le_top

@[to_additive]
lemma ker_le_comap (f : G →* H) (K : subgroup H) : f.ker ≤ comap f K :=
comap_mono bot_le

@[to_additive]
lemma map_comap_le (f : G →* H) (K : subgroup H) : map f (comap f K) ≤ K :=
(gc_map_comap f).l_u_le _

@[to_additive]
lemma le_comap_map (f : G →* H) (K : subgroup G) : K ≤ comap f (map f K) :=
(gc_map_comap f).le_u_l _

@[to_additive]
lemma map_comap_eq (f : G →* H) (K : subgroup H) :
  map f (comap f K) = f.range ⊓ K :=
set_like.ext' begin
  convert set.image_preimage_eq_inter_range,
  simp [set.inter_comm],
end

@[to_additive]
lemma comap_map_eq (f : G →* H) (K : subgroup G) :
  comap f (map f K) = K ⊔ f.ker :=
begin
  refine le_antisymm _ (sup_le (le_comap_map _ _) (ker_le_comap _ _)),
  intros x hx, simp only [exists_prop, mem_map, mem_comap] at hx,
  rcases hx with ⟨y, hy, hy'⟩,
  have : y⁻¹ * x ∈ f.ker, { rw mem_ker, simp [hy'] },
  convert mul_mem _ (mem_sup_left hy) (mem_sup_right this),
  simp,
end

@[to_additive]
lemma map_comap_eq_self {f : G →* H} {K : subgroup H} (h : K ≤ f.range) :
  map f (comap f K) = K :=
by rwa [map_comap_eq, inf_eq_right]

@[to_additive]
lemma map_comap_eq_self_of_surjective {f : G →* H} (h : function.surjective f) (K : subgroup H) :
  map f (comap f K) = K :=
map_comap_eq_self ((range_top_of_surjective _ h).symm ▸ le_top)

@[to_additive]
lemma comap_injective {f : G →* H} (h : function.surjective f) : function.injective (comap f) :=
λ K L hKL, by { apply_fun map f at hKL, simpa [map_comap_eq_self_of_surjective h] using hKL }

@[to_additive]
lemma comap_map_eq_self {f : G →* H} {K : subgroup G} (h : f.ker ≤ K) :
  comap f (map f K) = K :=
by rwa [comap_map_eq, sup_eq_left]

@[to_additive]
lemma comap_map_eq_self_of_injective {f : G →* H} (h : function.injective f) (K : subgroup G) :
  comap f (map f K) = K :=
comap_map_eq_self (((ker_eq_bot_iff _).mpr h).symm ▸ bot_le)

@[to_additive]
lemma map_injective {f : G →* H} (h : function.injective f) : function.injective (map f) :=
λ K L hKL, by { apply_fun comap f at hKL, simpa [comap_map_eq_self_of_injective h] using hKL }

@[to_additive]
lemma map_eq_comap_of_inverse {f : G →* H} {g : H →* G} (hl : function.left_inverse g f)
  (hr : function.right_inverse g f) (K : subgroup G) : map f K = comap g K :=
set_like.ext' $ by rw [coe_map, coe_comap, set.image_eq_preimage_of_inverse hl hr]

end subgroup


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

! This file was ported from Lean 3 source module data.nat.choose.multinomial
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Fin
import Mathbin.Data.Nat.Choose.Sum
import Mathbin.Data.Nat.Factorial.BigOperators
import Mathbin.Data.Fin.VecNotation
import Mathbin.Data.Finset.Sym
import Mathbin.Data.Finsupp.Multiset

/-!
# Multinomial

This file defines the multinomial coefficient and several small lemma's for manipulating it.

## Main declarations

- `nat.multinomial`: the multinomial coefficient

## Main results

- `finest.sum_pow`: The expansion of `(s.sum x) ^ n` using multinomial coefficients

-/

open BigOperators Nat

open BigOperators

namespace Nat

variable {α : Type _} (s : Finset α) (f : α → ℕ) {a b : α} (n : ℕ)

/-- The multinomial coefficient. Gives the number of strings consisting of symbols
from `s`, where `c ∈ s` appears with multiplicity `f c`.

Defined as `(∑ i in s, f i)! / ∏ i in s, (f i)!`.
-/
def multinomial : ℕ :=
  (∑ i in s, f i)! / ∏ i in s, (f i)!
#align nat.multinomial Nat.multinomial

theorem multinomial_pos : 0 < multinomial s f :=
  Nat.div_pos (le_of_dvd (factorial_pos _) (prod_factorial_dvd_factorial_sum s f))
    (prod_factorial_pos s f)
#align nat.multinomial_pos Nat.multinomial_pos

theorem multinomial_spec : (∏ i in s, (f i)!) * multinomial s f = (∑ i in s, f i)! :=
  Nat.mul_div_cancel' (prod_factorial_dvd_factorial_sum s f)
#align nat.multinomial_spec Nat.multinomial_spec

@[simp]
theorem multinomial_nil : multinomial ∅ f = 1 :=
  rfl
#align nat.multinomial_nil Nat.multinomial_nil

@[simp]
theorem multinomial_singleton : multinomial {a} f = 1 := by
  simp [multinomial, Nat.div_self (factorial_pos (f a))]
#align nat.multinomial_singleton Nat.multinomial_singleton

@[simp]
theorem multinomial_insert_one [DecidableEq α] (h : a ∉ s) (h₁ : f a = 1) :
    multinomial (insert a s) f = (s.Sum f).succ * multinomial s f :=
  by
  simp only [multinomial, one_mul, factorial]
  rw [Finset.sum_insert h, Finset.prod_insert h, h₁, add_comm, ← succ_eq_add_one, factorial_succ]
  simp only [factorial_one, one_mul, Function.comp_apply, factorial]
  rw [Nat.mul_div_assoc _ (prod_factorial_dvd_factorial_sum _ _)]
#align nat.multinomial_insert_one Nat.multinomial_insert_one

theorem multinomial_insert [DecidableEq α] (h : a ∉ s) :
    multinomial (insert a s) f = (f a + s.Sum f).choose (f a) * multinomial s f :=
  by
  rw [choose_eq_factorial_div_factorial (le.intro rfl)]
  simp only [multinomial, Nat.add_sub_cancel_left, Finset.sum_insert h, Finset.prod_insert h,
    Function.comp_apply]
  rw [div_mul_div_comm ((f a).factorial_mul_factorial_dvd_factorial_add (s.sum f))
      (prod_factorial_dvd_factorial_sum _ _),
    mul_comm (f a)! (s.sum f)!, mul_assoc, mul_comm _ (s.sum f)!,
    Nat.mul_div_mul _ _ (factorial_pos _)]
#align nat.multinomial_insert Nat.multinomial_insert

theorem multinomial_congr {f g : α → ℕ} (h : ∀ a ∈ s, f a = g a) :
    multinomial s f = multinomial s g :=
  by
  simp only [multinomial]; congr 1
  · rw [Finset.sum_congr rfl h]
  · exact Finset.prod_congr rfl fun a ha => by rw [h a ha]
#align nat.multinomial_congr Nat.multinomial_congr

/-! ### Connection to binomial coefficients

When `nat.multinomial` is applied to a `finset` of two elements `{a, b}`, the
result a binomial coefficient. We use `binomial` in the names of lemmas that
involves `nat.multinomial {a, b}`.
-/

theorem binomial_eq [DecidableEq α] (h : a ≠ b) :
    multinomial {a, b} f = (f a + f b)! / ((f a)! * (f b)!) := by
  simp [multinomial, Finset.sum_pair h, Finset.prod_pair h]
#align nat.binomial_eq Nat.binomial_eq

theorem binomial_eq_choose [DecidableEq α] (h : a ≠ b) :
    multinomial {a, b} f = (f a + f b).choose (f a) := by
  simp [binomial_eq _ h, choose_eq_factorial_div_factorial (Nat.le_add_right _ _)]
#align nat.binomial_eq_choose Nat.binomial_eq_choose

theorem binomial_spec [DecidableEq α] (hab : a ≠ b) :
    (f a)! * (f b)! * multinomial {a, b} f = (f a + f b)! := by
  simpa [Finset.sum_pair hab, Finset.prod_pair hab] using multinomial_spec {a, b} f
#align nat.binomial_spec Nat.binomial_spec

@[simp]
theorem binomial_one [DecidableEq α] (h : a ≠ b) (h₁ : f a = 1) :
    multinomial {a, b} f = (f b).succ := by
  simp [multinomial_insert_one {b} f (finset.not_mem_singleton.mpr h) h₁]
#align nat.binomial_one Nat.binomial_one

theorem binomial_succ_succ [DecidableEq α] (h : a ≠ b) :
    multinomial {a, b} ((f.update a (f a).succ).update b (f b).succ) =
      multinomial {a, b} (f.update a (f a).succ) + multinomial {a, b} (f.update b (f b).succ) :=
  by
  simp only [binomial_eq_choose, Function.update_apply, Function.update_noteq, succ_add, add_succ,
    choose_succ_succ, h, Ne.def, not_false_iff, Function.update_same]
  rw [if_neg h.symm]
  ring
#align nat.binomial_succ_succ Nat.binomial_succ_succ

theorem succ_mul_binomial [DecidableEq α] (h : a ≠ b) :
    (f a + f b).succ * multinomial {a, b} f =
      (f a).succ * multinomial {a, b} (f.update a (f a).succ) :=
  by
  rw [binomial_eq_choose _ h, binomial_eq_choose _ h, mul_comm (f a).succ, Function.update_same,
    Function.update_noteq (ne_comm.mp h)]
  convert succ_mul_choose_eq (f a + f b) (f a)
  exact succ_add (f a) (f b)
#align nat.succ_mul_binomial Nat.succ_mul_binomial

/-! ### Simple cases -/

theorem multinomial_univ_two (a b : ℕ) : multinomial Finset.univ ![a, b] = (a + b)! / (a ! * b !) :=
  by simp [multinomial, Fin.sum_univ_two, Fin.prod_univ_two]
#align nat.multinomial_univ_two Nat.multinomial_univ_two

theorem multinomial_univ_three (a b c : ℕ) :
    multinomial Finset.univ ![a, b, c] = (a + b + c)! / (a ! * b ! * c !) := by
  simp [multinomial, Fin.sum_univ_three, Fin.prod_univ_three]
#align nat.multinomial_univ_three Nat.multinomial_univ_three

end Nat

/-! ### Alternative definitions -/

namespace Finsupp

variable {α : Type _}

/-- Alternative multinomial definition based on a finsupp, using the support
  for the big operations
-/
def multinomial (f : α →₀ ℕ) : ℕ :=
  (f.Sum fun _ => id)! / f.Prod fun _ n => n !
#align finsupp.multinomial Finsupp.multinomial

theorem multinomial_eq (f : α →₀ ℕ) : f.multinomial = Nat.multinomial f.support f :=
  rfl
#align finsupp.multinomial_eq Finsupp.multinomial_eq

theorem multinomial_update (a : α) (f : α →₀ ℕ) :
    f.multinomial = (f.Sum fun _ => id).choose (f a) * (f.update a 0).multinomial :=
  by
  simp only [multinomial_eq]
  classical
    by_cases a ∈ f.support
    · rw [← Finset.insert_erase h, Nat.multinomial_insert _ f (Finset.not_mem_erase a _),
        Finset.add_sum_erase _ f h, support_update_zero]
      congr 1
      exact
        Nat.multinomial_congr _ fun _ h => (Function.update_noteq (Finset.mem_erase.1 h).1 0 f).symm
    rw [not_mem_support_iff] at h
    rw [h, Nat.choose_zero_right, one_mul, ← h, update_self]
#align finsupp.multinomial_update Finsupp.multinomial_update

end Finsupp

namespace Multiset

variable {α : Type _}

/-- Alternative definition of multinomial based on `multiset` delegating to the
  finsupp definition
-/
noncomputable def multinomial (m : Multiset α) : ℕ :=
  m.toFinsupp.multinomial
#align multiset.multinomial Multiset.multinomial

theorem multinomial_filter_ne [DecidableEq α] (a : α) (m : Multiset α) :
    m.multinomial = m.card.choose (m.count a) * (m.filterₓ ((· ≠ ·) a)).multinomial :=
  by
  dsimp only [multinomial]
  convert Finsupp.multinomial_update a _
  · rw [← Finsupp.card_toMultiset, m.to_finsupp_to_multiset]
  · ext1 a'
    rw [to_finsupp_apply, count_filter, Finsupp.coe_update]
    split_ifs
    · rw [Function.update_noteq h.symm, to_finsupp_apply]
    · rw [not_ne_iff.1 h, Function.update_same]
#align multiset.multinomial_filter_ne Multiset.multinomial_filter_ne

end Multiset

namespace Finset

/-! ### Multinomial theorem -/

variable {α : Type _} [DecidableEq α] (s : Finset α) {R : Type _}

/-- The multinomial theorem

  Proof is by induction on the number of summands.
-/
theorem sum_pow_of_commute [Semiring R] (x : α → R)
    (hc : (s : Set α).Pairwise fun i j => Commute (x i) (x j)) :
    ∀ n,
      s.Sum x ^ n =
        ∑ k : s.Sym n,
          k.1.1.multinomial *
            (k.1.1.map <| x).noncommProd
              (Multiset.map_set_pairwise <| hc.mono <| mem_sym_iff.1 k.2) :=
  by
  induction' s using Finset.induction with a s ha ih
  · rw [sum_empty]
    rintro (_ | n)
    · rw [pow_zero, Fintype.sum_subsingleton]
      swap
      · exact ⟨0, Or.inl rfl⟩
      convert(one_mul _).symm
      apply Nat.cast_one
    · rw [pow_succ, MulZeroClass.zero_mul]
      apply (Fintype.sum_empty _).symm
      rw [sym_empty]
      infer_instance
  intro n; specialize ih (hc.mono <| s.subset_insert a)
  rw [sum_insert ha, (Commute.sum_right s _ _ fun b hb => _).add_pow, sum_range]; swap
  · exact hc (mem_insert_self a s) (mem_insert_of_mem hb) (ne_of_mem_of_not_mem hb ha).symm
  simp_rw [ih, mul_sum, sum_mul, sum_sigma', univ_sigma_univ]
  refine' (Fintype.sum_equiv (sym_insert_equiv ha) _ _ fun m => _).symm
  rw [m.1.1.multinomial_filter_ne a]
  conv in m.1.1.map _ => rw [← m.1.1.filter_add_not ((· = ·) a), Multiset.map_add]
  simp_rw [Multiset.noncommProd_add, m.1.1.filter_eq, Multiset.map_replicate, m.1.2]
  rw [Multiset.noncommProd_eq_pow_card _ _ _ fun _ => Multiset.eq_of_mem_replicate]
  rw [Multiset.card_replicate, Nat.cast_mul, mul_assoc, Nat.cast_comm]
  congr 1; simp_rw [← mul_assoc, Nat.cast_comm]; rfl
#align finset.sum_pow_of_commute Finset.sum_pow_of_commute

theorem sum_pow [CommSemiring R] (x : α → R) (n : ℕ) :
    s.Sum x ^ n = ∑ k in s.Sym n, k.val.multinomial * (k.val.map x).Prod :=
  by
  conv_rhs => rw [← sum_coe_sort]
  convert sum_pow_of_commute s x (fun _ _ _ _ _ => mul_comm _ _) n
  ext1; rw [Multiset.noncommProd_eq_prod]; rfl
#align finset.sum_pow Finset.sum_pow

end Finset


/-
Copyright (c) 2020 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.nat.parity
import data.zmod.basic
/-!
# Relating parity to natural numbers mod 2

This module provides lemmas relating `zmod 2` to `even` and `odd`.

## Tags

parity, zmod, even, odd
-/

namespace zmod

lemma eq_zero_iff_even {n : ℕ} : (n : zmod 2) = 0 ↔ even n :=
(char_p.cast_eq_zero_iff (zmod 2) 2 n).trans even_iff_two_dvd.symm

lemma eq_one_iff_odd {n : ℕ} : (n : zmod 2) = 1 ↔ odd n :=
by { rw [← @nat.cast_one (zmod 2), zmod.eq_iff_modeq_nat, nat.odd_iff, nat.modeq], norm_num }

end zmod


import data.real.basic

variables a b c : ℝ

#check mul_comm b a
#check mul_assoc c b a

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  /- mul_comm a b refers to the communicative law for multiplication
  on a and b: a * b = b * a. 'rw mul_comm a b' tells Lean to replace
  a * b with b * a in the goal. -/

  rw mul_assoc b a c,
  /- mul_assoc b a c refers to the associative law for multiplication
  on b, a, and c: b * a * c = b * (a * c). Note that Lean leaves out
  parentheses when possible. Since multiplication associates to the left,
  the left-hand side of mul_assoc b * a * c refers to (b * a) * c.
  'rw mul_assoc b a c' solves the goal b * a * c = b * (a * c), and hence,
  completes the proof. -/
end


/-
    Stalk (of types).

    https://stacks.math.columbia.edu/tag/0078
-/

import to_mathlib.opens
import topology.basic
import sheaves.presheaf

universe u

section stalk

variables {α : Type u} [topological_space α]
variables (F : presheaf α) (x : α)

open topological_space

-- An element in the stalk is a pair (U, s) under an equivalence relation

structure stalk.elem :=
(U   : opens α)
(HxU : x ∈ U)
(s   : F U)

-- Equivalence relation on the set of pairs. (U,s) ~ (V,t) iff there exists W
-- open s.t. x ∈ W ⊆ U ∩ V, and s|W = t|W.

def stalk.relation : stalk.elem F x → stalk.elem F x → Prop :=
λ Us Vt,
    ∃ (W : opens α) (HxW : x ∈ W) (HWU : W ⊆ Us.U) (HWV : W ⊆ Vt.U),
    F.res Us.U W HWU Us.s = F.res Vt.U W HWV Vt.s

lemma stalk.relation.reflexive : reflexive (stalk.relation F x) :=
λ ⟨U, HxU, s⟩, ⟨U, HxU, set.subset.refl _, set.subset.refl _, rfl⟩

lemma stalk.relation.symmetric : symmetric (stalk.relation F x) :=
λ Us Vt ⟨W, HxW, HWU, HWV, Hres⟩, ⟨W, HxW, HWV, HWU, Hres.symm⟩

lemma stalk.relation.transitive : transitive (stalk.relation F x) :=
λ ⟨U, HxU, sU⟩ ⟨V, HxV, sV⟩ ⟨W, HxW, sW⟩,
λ ⟨R, HxR, HRU, HRV, HresR⟩ ⟨S, HxS, HSV, HSW, HresS⟩,
⟨R ∩ S, ⟨HxR, HxS⟩,
λ y ⟨HyR, _⟩, HRU HyR, λ y ⟨_, HyS⟩, HSW HyS,
have HURRS : _ := F.Hcomp U R (R ∩ S) (set.inter_subset_left _ _) HRU,
have HVRRS : _ := F.Hcomp V R (R ∩ S) (set.inter_subset_left _ _) HRV,
have HVSRS : _ := F.Hcomp V S (R ∩ S) (set.inter_subset_right _ _) HSV,
have HWSRS : _ := F.Hcomp W S (R ∩ S) (set.inter_subset_right _ _) HSW,
calc  F.res U (R ∩ S) _ sU
    = F.res R (R ∩ S) _ (F.res U R _ sU) : congr_fun HURRS sU
... = F.res R (R ∩ S) _ (F.res V R _ sV) : congr_arg _ HresR
... = F.res V (R ∩ S) _ sV               : congr_fun HVRRS.symm sV
... = F.res S (R ∩ S) _ (F.res V S _ sV) : congr_fun HVSRS sV
... = F.res S (R ∩ S) _ (F.res W S _ sW) : congr_arg _ HresS
... = F.res W (R ∩ S) _ sW               : congr_fun HWSRS.symm sW⟩

lemma stalk.relation.equivalence : equivalence (stalk.relation F x) :=
⟨stalk.relation.reflexive F x,
stalk.relation.symmetric F x,
stalk.relation.transitive F x⟩

instance stalk.setoid : setoid (stalk.elem F x) :=
{ r := stalk.relation F x,
  iseqv := stalk.relation.equivalence F x }

-- We define a stalk as the set of stalk elements under the defined relation.

definition stalk := quotient (stalk.setoid F x)

end stalk


/-  MATH40001 : Introduction to university mathematics.

Peano Axioms - Extra Practice, October 2020.

These questions are based on Dr Lawn's Practice Questions
on Blackboard.

This is a Lean file. It can be read with the Lean theorem prover.

You can work on this file online at the following URL:

or you can install Lean and its maths library following the instructions at
https://leanprover-community.github.io/get_started.html

There are advantages to installing Lean on your own computer
(for example it's faster), but it's more hassle than just using it online.

Replace the sorries for the theorems you think are provable
with tactics which prove them.

Here, we use the function `succ` instead of `ν`.
-/

import data.nat.basic

open nat function

#check (succ : ℕ → ℕ)
#reduce succ 0
#reduce succ 36

theorem exists_succ_true : ∃ (ν : ℕ → ℕ), ν = succ :=
begin
  sorry
end

theorem exists_succ_false : ¬ ∃ (ν : ℕ → ℕ), ν = succ :=
begin
  sorry
end

theorem succ_injective_true : injective succ :=
begin
  unfold injective,
  sorry
end

theorem succ_injective_false : ¬ injective succ :=
begin
  unfold injective,
  sorry
end

theorem succ_surjective_true : surjective succ :=
begin
  unfold surjective,
  sorry
end

theorem succ_surjective_false : ¬ surjective succ :=
begin
  unfold surjective,
  sorry
end

theorem all_functions_are_succ_true : ∀ (ν : ℕ → ℕ), ν = succ :=
begin
  sorry
end

theorem all_functions_are_succ_false : ¬ ∀ (ν : ℕ → ℕ), ν = succ :=
begin
  sorry
end

theorem exists_unique_zero_true : ∃! n : ℕ, n = 0 :=
begin
  sorry
end

theorem exists_unique_zero_false : ¬ ∃! n : ℕ, n = 0:=
begin
  sorry
end

/-
The lemma
`funext_iff` : (f₁ = f₂) ↔ (∀ x, f₁ x = f₂ x)
might come in handy somewhere above.

Next, try writing down the Peano Axioms as given in the lectures/notes:

type `\forall`, `\exists`, `\nu`, `\in`, `\sub` and `\to`
and then SPACE or TAB for their respective symbols ∀ ∃ ν ∈ ⊆ →
-/

def N : set ℕ := {n | true} -- Let `N` be the set of all natural numbers

def Peano_Axiom_1 : Prop := 0 ∈ N -- as an example
def Peano_Axiom_2 : Prop := sorry
def Peano_Axiom_3 : Prop := sorry
def Peano_Axiom_4 : Prop := sorry
def Peano_Axiom_5 : Prop := sorry

-- Lean Fun Facts!

set_option pp.numerals false  -- changes lean's pretty printer options

#reduce succ 5
#reduce 37

#check 6
#check 37

-- Compare Lean's recursor with (P5)
#check (@nat.rec : ∀ {C : ℕ → Sort*}, C 0 → (∀ n, C n → C (succ n)) → ∀ n, C n)


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebraic_geometry.prime_spectrum.basic
import ring_theory.polynomial.basic
/-!
The morphism `Spec R[x] --> Spec R` induced by the natural inclusion `R --> R[x]` is an open map.

The main result is the first part of the statement of Lemma 00FB in the Stacks Project.

https://stacks.math.columbia.edu/tag/00FB
-/

open ideal polynomial prime_spectrum set
open_locale polynomial

namespace algebraic_geometry

namespace polynomial

variables {R : Type*} [comm_ring R] {f : R[X]}

/-- Given a polynomial `f ∈ R[x]`, `image_of_Df` is the subset of `Spec R` where at least one
of the coefficients of `f` does not vanish.  Lemma `image_of_Df_eq_comap_C_compl_zero_locus`
proves that `image_of_Df` is the image of `(zero_locus {f})ᶜ` under the morphism
`comap C : Spec R[x] → Spec R`. -/
def image_of_Df (f) : set (prime_spectrum R) :=
  {p : prime_spectrum R | ∃ i : ℕ , (coeff f i) ∉ p.as_ideal}

lemma is_open_image_of_Df : is_open (image_of_Df f) :=
begin
  rw [image_of_Df, set_of_exists (λ i (x : prime_spectrum R), coeff f i ∉ x.val)],
  exact is_open_Union (λ i, is_open_basic_open),
end

/-- If a point of `Spec R[x]` is not contained in the vanishing set of `f`, then its image in
`Spec R` is contained in the open set where at least one of the coefficients of `f` is non-zero.
This lemma is a reformulation of `exists_coeff_not_mem_C_inverse`. -/
lemma comap_C_mem_image_of_Df {I : prime_spectrum R[X]}
  (H : I ∈ (zero_locus {f} : set (prime_spectrum R[X]))ᶜ ) :
  prime_spectrum.comap (polynomial.C : R →+* R[X]) I ∈ image_of_Df f :=
exists_coeff_not_mem_C_inverse (mem_compl_zero_locus_iff_not_mem.mp H)

/-- The open set `image_of_Df f` coincides with the image of `basic_open f` under the
morphism `C⁺ : Spec R[x] → Spec R`. -/
lemma image_of_Df_eq_comap_C_compl_zero_locus :
  image_of_Df f = prime_spectrum.comap (C : R →+* R[X]) '' (zero_locus {f})ᶜ :=
begin
  refine ext (λ x, ⟨λ hx, ⟨⟨map C x.val, (is_prime_map_C_of_is_prime x.property)⟩, ⟨_, _⟩⟩, _⟩),
  { rw [mem_compl_eq, mem_zero_locus, singleton_subset_iff],
    cases hx with i hi,
    exact λ a, hi (mem_map_C_iff.mp a i) },
  { refine subtype.ext (ext (λ x, ⟨λ h, _, λ h, subset_span (mem_image_of_mem C.1 h)⟩)),
    rw ← @coeff_C_zero R x _,
    exact mem_map_C_iff.mp h 0 },
  { rintro ⟨xli, complement, rfl⟩,
    exact comap_C_mem_image_of_Df complement }
end

/--  The morphism `C⁺ : Spec R[x] → Spec R` is open.
Stacks Project "Lemma 00FB", first part.

https://stacks.math.columbia.edu/tag/00FB
-/
theorem is_open_map_comap_C :
  is_open_map (prime_spectrum.comap (C : R →+* R[X])) :=
begin
  rintros U ⟨s, z⟩,
  rw [← compl_compl U, ← z, ← Union_of_singleton_coe s, zero_locus_Union, compl_Inter, image_Union],
  simp_rw [← image_of_Df_eq_comap_C_compl_zero_locus],
  exact is_open_Union (λ f, is_open_image_of_Df),
end

end polynomial

end algebraic_geometry


import data.real.basic
import topology.metric_space.basic
import analysis.specific_limits
import topology.sequences
import order.filter.at_top_bot
import tactic

variable {f : ℝ → ℝ}
variable {x₀ : ℝ}
variable {u : ℕ → ℝ}
variable {φ : ℕ → ℕ}

-- ----------------------------------------------------
-- Ejercicio. Definir la notación |x| para el valor
-- absoluto de x.
-- ----------------------------------------------------

notation `|`x`|` := abs x

-- ----------------------------------------------------
-- Ejercicio. Definir la función
--    limite : (ℕ → ℝ) → ℝ → Prop
-- tal que (limite u c) expresa que c es el límite de
-- la sucesión u.
-- ----------------------------------------------------

def limite : (ℕ → ℝ) → ℝ → Prop :=
λ u c, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| ≤ ε

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (∀ ε > 0, y ≤ x + ε) →  y ≤ x
-- ----------------------------------------------------------------------

lemma le_of_le_add_all
  {x y : ℝ}
  : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si x es el límite de u y
--    ∃ N, ∀ n ≥ N, y ≤ u n
-- entonce y ≤ x.
-- ----------------------------------------------------------------------

lemma le_lim
  {x y : ℝ}
  {u : ℕ → ℝ}
  (hu : limite u x)
  (h : ∃ N, ∀ n ≥ N, y ≤ u n)
  : y ≤ x :=
begin
  apply le_of_le_add_all,
  intros ε hε,
  cases hu ε hε with N hN,
  cases h 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

-- ----------------------------------------------------
-- Ejercicio. Definir la función
--    cota_superior : set ℝ → ℝ → Prop
-- tal que (cota_superior A x) expresa que x es una
-- cota superior de A.
-- ----------------------------------------------------

def cota_superior : set ℝ → ℝ → Prop :=
λ A x, ∀ a ∈ A, a ≤ x

-- ----------------------------------------------------
-- Ejercicio. Definir la función
--    es_supremo : set ℝ → ℝ → Prop
-- tal que (es_supremos A x) expresa que x es el
-- supremo de A.
-- ----------------------------------------------------

def es_supremo : set ℝ → ℝ → Prop :=
λ A x, cota_superior A x ∧ ∀ y, cota_superior A y → x ≤ y

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si x es el supremo de A,
-- entonces
--    ∀ y, y < x → ∃ a ∈ A, y < a
-- ----------------------------------------------------------------------

lemma lt_sup
  {A : set ℝ}
  {x : ℝ} (
  hx : es_supremo A x)
  : ∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    limite (λ n, x) x
-- ----------------------------------------------------------------------

lemma limit_const
  (x : ℝ)
  : limite (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si x es el límite de u e y es una cota
-- superior de u, entonces x ≤ y.
-- ----------------------------------------------------------------------

lemma lim_le
  {x y : ℝ}
  {u : ℕ → ℝ}
  (hu : limite u x)
  (ineg : ∀ n, u n ≤ y)
  : x ≤ y :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_le at hN,
  linarith,
end

-- ----------------------------------------------------
-- Ejercicio. Demostrar que si dos sucesiones tienen
-- el mismo límite, entonces las sucesiones que están
-- comprendidas entre éstas también tienen el mismo
-- límite.
-- ----------------------------------------------------

-- Nota. En la demostración se usará el siguiente lema:
lemma max_ge_iff
  {p q r : ℕ}
  : r ≥ max p q ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

lemma emparedado
  {u v w : ℕ → ℝ}
  {a : ℝ}
  (hu : limite u a)
  (hw : limite w a)
  (h : ∀ n, u n ≤ v n)
  (h' : ∀ n, v n ≤ w n)
  : limite v a :=
begin
  intros ε hε,
  cases hu ε hε with N hN, clear hu,
  cases hw ε hε with N' hN', clear hw hε,
  use max N N',
  intros n hn,
  rw max_ge_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split ; linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε
-- ----------------------------------------------------------------------

lemma inv_succ_le_all :
  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    { intros h ε ε_pos,
      cases h (ε/2) (by linarith) with N hN,
      use N,
      intros n hn,
      rw abs_of_pos (nat.one_div_pos_of_nat : 1/(n+1 : ℝ) > 0),
      specialize hN n hn,
      linarith, },
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (@nat.one_div_pos_of_nat ℝ _ n) at hN,
  linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    ∀ n, |u n - x| ≤ 1/(n+1) ⊢ limite u x
-- ----------------------------------------------------------------------

lemma limit_of_sub_le_inv_succ
  {u : ℕ → ℝ}
  {x : ℝ}
  (h : ∀ n, |u n - x| ≤ 1/(n+1))
  : limite u x :=
begin
  intros ε ε_pos,
  rcases inv_succ_le_all ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que x es el límite de
--   x - 1/(n+1)
-- ----------------------------------------------------------------------

lemma limit_const_sub_inv_succ
  (x : ℝ)
  : limite (λ n, x - 1/(n+1)) x :=
begin
  refine limit_of_sub_le_inv_succ (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [@nat.one_div_pos_of_nat ℝ _ n]
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que son equivalentes
-- + es_supremo A x
-- + cota_superior A x ∧ ∃ u : ℕ → ℝ, limite u x ∧ ∀ n, u n ∈ A
-- ----------------------------------------------------------------------

lemma es_supremo_iff
  (A : set ℝ)
  (x : ℝ)
  : (es_supremo A x) ↔
    (cota_superior A x ∧ ∃ u : ℕ → ℝ, limite u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    { exact h.left, },
    { 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 emparedado (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

-- ----------------------------------------------------
-- Ejercicio. Definir la función
--    continua_en_punto : (ℝ → ℝ) → ℝ → Prop
-- tal que (continua_en_punto f x₀) expresa que f es
-- continua en x₀.
-- ----------------------------------------------------

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

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si el límite de f es x₀ y f es continua en
-- x₀, entonces el límite de (f ∘ u) es f(x₀).
-- ----------------------------------------------------------------------

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

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    ∀ u : ℕ → ℝ, limite u x₀ → limite (f ∘ u) (f x₀)
-- entonces f es continua en x₀.
-- ----------------------------------------------------------------------

example :
  (∀ u : ℕ → ℝ, limite u x₀ → limite (f ∘ u) (f x₀)) →
  continua_en_punto f x₀ :=
begin
  contrapose!,
  intro hf,
  unfold continua_en_punto at hf,
  push_neg at hf,
  cases hf with ε h,
  cases h with ε_pos hf,
  have H : ∀ n : ℕ, ∃ x, |x - x₀| ≤ 1/(n+1) ∧ ε < |f x - f x₀|,
    intro n,
    apply hf,
    exact nat.one_div_pos_of_nat,
  clear hf,
  choose u hu using H,
  use u,
  split,
    intros η η_pos,
    have fait : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → 1 / (↑n + 1) ≤ η,
      exact inv_succ_le_all η η_pos,
    cases fait with N hN,
    use N,
    intros n hn,
    calc |u n - x₀| ≤ 1/(n+1) : (hu n).left
                ... ≤ η       : hN n hn,
  unfold limite,
  push_neg,
  use [ε, ε_pos],
  intro N,
  use N,
  split,
  linarith,
  exact (hu N).right,
end

-- ----------------------------------------------------
-- Ejercicio. Definir la función
-- ----------------------------------------------------

def tiende_a_infinito : (ℕ → ℝ) → Prop :=
λ u, ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

-- ----------------------------------------------------
-- Ejercicio. Para extraer una sucesión se aplica una
-- función de extracción que conserva el orden; por
-- ejemplo, la subsucesión
--    uₒ, u₂, u₄, u₆, ...
-- se ha obtenido con la función de extracción φ tal
-- que φ(n) = 2*n.
--
-- Definir la función
--    extraccion : (ℕ → ℕ) → Prop
-- tal que (extraccion φ) expresa que φ es una función
-- de extracción
-- ----------------------------------------------------

def extraccion : (ℕ → ℕ) → Prop
| φ := ∀ n m, n < m → φ n < φ m

-- ----------------------------------------------------
-- Ejercicio. Demostrar que si φ es una función de
-- extracción, entonces
--    ∀ n, n ≤ φ n
-- ----------------------------------------------------

lemma id_mne_extraccion :
  extraccion φ → ∀ n, n ≤ φ n :=
begin
  intros h n,
  induction n with m HI,
  { linarith },
  { apply nat.succ_le_of_lt,
    linarith [h m (m+1) (by linarith)] },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si u tiende a infinito y φ es una función de
-- extracción, entonces (u ∘ φ) tiende a infinito.
-- ----------------------------------------------------------------------

lemma subseq_tenstoinfinity
  (h : tiende_a_infinito u)
  (hφ : extraccion φ)
  : tiende_a_infinito (u ∘ φ) :=
begin
  intros A,
  cases h A with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_mne_extraccion hφ n,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si u tiende al infinito y
--    ∀ n, u n ≤ v n
-- entonces v tiende al infinito.
-- ----------------------------------------------------------------------

lemma squeeze_infinity
  {u v : ℕ → ℝ}
  (hu : tiende_a_infinito u)
  (huv : ∀ n, u n ≤ v n)
  : tiende_a_infinito v :=
begin
  intros A,
  cases hu A with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  specialize huv n,
  linarith,
end

open set

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la sucesión identidad tiende a infinito.
-- ----------------------------------------------------------------------

lemma limite_id : tiende_a_infinito (λ n, n) :=
begin
  intros A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N,
    exact_mod_cast hn,
  linarith,
end

-- ----------------------------------------------------
-- Ejercicio. Definir la función
--    punto_acumulacion : (ℕ → ℝ) → ℝ → Prop
-- tal que (punto_acumulacion u a) expresa que a es un
-- punto de acumulación de u; es decir, que es el
-- límite de alguna subsucesión de u.
-- ----------------------------------------------------

def punto_acumulacion : (ℕ → ℝ) → ℝ → Prop
| u a := ∃ φ, extraccion φ ∧ limite (u ∘ φ) a

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si es una sucesión en [a,b], entonces
-- existe algún c en [a,b] que es el punto de acumulación de u.
-- ----------------------------------------------------------------------

lemma bolzano_weierstrass
  {a b : ℝ}
  {u : ℕ → ℝ}
  (h : ∀ n, u n ∈ Icc a b)
  : ∃ c ∈ Icc a b, punto_acumulacion u c :=
begin
  rcases (compact_Icc : is_compact (Icc a b)).tendsto_subseq h with ⟨c, c_in, φ, hφ, lim⟩,
  use [c, c_in, φ, hφ],
  simp_rw [metric.tendsto_nhds, filter.eventually_at_top, real.dist_eq] at lim,
  intros ε ε_pos,
  rcases lim ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact le_of_lt (hN n hn)
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    tiende_a_infinito u → ∀ x, ¬ limite u x
-- ----------------------------------------------------------------------

lemma not_seq_limit_of_tendstoinfinity
  {u : ℕ → ℝ} :
  tiende_a_infinito u → ∀ x, ¬ limite u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua en [a,b], entonces existe
-- un M tal que, para todo x ∈ [a,b], f(x) ≤ M.
-- ----------------------------------------------------------------------

lemma bdd_above_segment
  {f : ℝ → ℝ}
  {a b : ℝ}
  (hf : ∀ x ∈ Icc a b, continua_en_punto f x)
  : ∃ M, ∀ x ∈ Icc a b, f x ≤ M :=
begin
  by_contradiction H,
  push_neg at H,
  have clef : ∀ n : ℕ, ∃ x, x ∈ Icc a b ∧ f x > n,
    intro n,
    apply H,
    clear H,
  choose u hu using clef,
  have lim_infinie : tiende_a_infinito (f ∘ u),
    apply squeeze_infinity (limite_id),
    intros n,
    specialize hu n,
    linarith,
  have bornes : ∀ n, u n ∈ Icc a b,
    intro n,
    exact (hu n).left,
  rcases bolzano_weierstrass bornes with ⟨c, c_dans, φ, φ_extr, lim⟩,
  have lim_infinie_extr : tiende_a_infinito (f ∘ (u ∘ φ)),
    exact subseq_tenstoinfinity lim_infinie φ_extr,
  have lim_extr : limite (f ∘ (u ∘ φ)) (f c),
    exact seq_continuous_of_continuous (hf c c_dans) lim,
  exact not_seq_limit_of_tendstoinfinity lim_infinie_extr (f c) lim_extr,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua en x₀, también lo es -f.
-- ----------------------------------------------------------------------

lemma continuous_opposite
  {f : ℝ → ℝ}
  {x₀ : ℝ}
  (h : continua_en_punto f x₀)
  : continua_en_punto (λ x, -f x) x₀ :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with δ h,
  cases h with δ_pos h,
  use [δ, δ_pos],
  intros y hy,
  have :  -f y - -f x₀ = -(f y - f x₀), ring,
  rw [this, abs_neg],
  exact h y hy,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua en [a,b], entonces existe
-- un m en [a,b] tal que, para todo x de [a,b], m ≤ f(x).
-- ----------------------------------------------------------------------

lemma bdd_below_segment
  {f : ℝ → ℝ}
  {a b : ℝ}
  (hf : ∀ x ∈ Icc a b, continua_en_punto f x)
  : ∃ m, ∀ x ∈ Icc a b, m ≤ f x :=
begin
  have : ∃ M, ∀ x ∈ Icc a b, -f x ≤ M,
  { apply bdd_above_segment,
    intros x x_dans,
    exact continuous_opposite (hf x x_dans), },
  cases this with M hM,
  use -M,
  intros x x_dans,
  specialize hM x x_dans,
  linarith,
end

open real

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si A es un subconjunto no vacío de [a,b],
-- entonces existe un x en [a,b] que es el supremo de A.
-- ----------------------------------------------------------------------

lemma sup_segment
  {a b : ℝ}
  {A : set ℝ}
  (hnonvide : ∃ x, x ∈ A)
  (h : A ⊆ Icc a b)
  : ∃ x ∈ Icc a b, es_supremo A x :=
begin
  have b_maj : ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : cota_superior A (Sup A),
  { intro x,
    apply real.le_Sup,
    use [b, b_maj] } ,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { apply Sup_le_ub A hnonvide b_maj } },
  { use Sup_maj,
    intros y y_in,
    rwa real.Sup_le _ hnonvide ⟨b, b_maj⟩ },
end

-- ----------------------------------------------------
-- Ejercicio. Demostrar que cada sucesión tiene como
-- máximo un límite.
-- ----------------------------------------------------

lemma unicidad_limite
  {a b : ℝ}
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  by_contradiction H,
  change a ≠ b at H,
  have h1 : |a - b| > 0,
    exact abs_pos.mpr (sub_ne_zero_of_ne H),
  cases ha (|a - b|/4) (by linarith) with N hN,
  cases hb (|a - b|/4) (by linarith) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  have h2 : |a - b| < |a - b |,
    calc  |a - b| = |(a - u N₀) + (u N₀ - b)| : by ring
    ... ≤ |a - u N₀| + |u N₀ - b|             : by apply abs_add
    ... = |u N₀ - a| + |u N₀ - b|             : by rw abs_sub
    ... < |a - b|                             : by linarith,
  linarith,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si l es el límite de u y φ es una extracción,
-- entonces l es el límite de (u ∘ φ).
-- ----------------------------------------------------------------------

lemma subseq_tendsto_of_tendsto
  {l : ℝ}
  (h : limite u l)
  (hφ : extraccion φ)
  : limite (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_mne_extraccion hφ n,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua en [a,b], existe un x₀ ∈ [a,b],
-- tal que, para todo x ∈ [a,b], f(x) ≤ f(x₀).
-- ----------------------------------------------------------------------

example
  {a b : ℝ}
  (hab : a ≤ b)
  (hf : ∀ x ∈ Icc a b, continua_en_punto f x)
  : ∃ x₀ ∈ Icc a b, ∀ x ∈ Icc a b, f x ≤ f x₀ :=
begin
  cases bdd_below_segment hf with m hm,
  cases bdd_above_segment hf with M hM,
  let A := {y | ∃ x ∈ Icc a b, y = f x},
  obtain ⟨y₀, y_dans, y_sup⟩ : ∃ y₀ ∈ Icc m M, es_supremo A y₀,
  { apply sup_segment,
    { use [f a, a, by linarith, hab, by ring], },
    { rintros y ⟨x, x_in, rfl⟩,
      exact ⟨hm x x_in, hM x x_in⟩ } },
  rw es_supremo_iff at y_sup,
  rcases y_sup with ⟨y_maj, u, lim_u, u_dans⟩,
  choose v hv using u_dans,
  cases forall_and_distrib.mp hv with v_dans hufv,
  replace hufv : u = f ∘ v := funext hufv,
  rcases bolzano_weierstrass v_dans with ⟨x₀, x₀_in, φ, φ_extr, lim_vφ⟩,
  use [x₀, x₀_in],
  intros x x_dans,
  have lim : limite (f ∘ v ∘ φ) (f x₀),
  { apply seq_continuous_of_continuous,
    exact hf x₀ x₀_in,
    exact lim_vφ },
  have unique : f x₀ = y₀,
  { apply unicidad_limite lim,
    rw hufv at lim_u,
    exact subseq_tendsto_of_tendsto lim_u φ_extr },
  rw unique,
  apply y_maj,
  use [x, x_dans],
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si x ∈ [a,b] y x ≠ b, entonces x < b.
-- ----------------------------------------------------------------------

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

-- ----------------------------------------------------
-- Ejercicio. Definir I como el intervalo [0,1].
-- ----------------------------------------------------

def I := (Icc 0 1 : set ℝ)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que x es el límite de
--    x + 1/(n+1)
-- ----------------------------------------------------------------------

lemma limit_const_add_inv_succ
  (x : ℝ)
  : limite (λ n, x + 1/(n+1)) x :=
limit_of_sub_le_inv_succ (λ n, by rw abs_of_pos ;
linarith [@nat.one_div_pos_of_nat ℝ _ n])

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua, f(0) < 0 y f(1) > 0,
-- entonces existe un x₀ ∈ I tal que f(x₀) = 0.
-- ----------------------------------------------------------------------

example
  (f : ℝ → ℝ)
  (hf : ∀ x, continua_en_punto f x)
  (h₀ : f 0 < 0)
  (h₁ : f 1 > 0)
  : ∃ x₀ ∈ I, f x₀ = 0 :=
begin
  let A := { x | x ∈ I ∧ f x < 0},
  have ex_x₀ : ∃ x₀ ∈ I, es_supremo A x₀,
  { apply sup_segment,
      use 0,
      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₀ ≤ 0,
  { rw es_supremo_iff at x₀_sup,
    rcases x₀_sup with ⟨maj_x₀, u, lim_u, u_dans⟩,
    have : limite (f ∘ u) (f x₀),
      exact seq_continuous_of_continuous (hf x₀) lim_u,
    apply lim_le this,
    intros n,
    have : f (u n) < 0,
      exact (u_dans n).right,
    linarith  },
  have x₀_1: x₀ < 1,
  { apply stupid x₀_in,
    intro h,
    rw ← h at h₁,
    linarith  },
  have : f x₀ ≥ 0,
  { have in_I : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ I,
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ 1-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 0 ≤ x₀ ∧ x₀ ≤ 1 at x₀_in,
      split ; linarith, },
    have not_in : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    -- By definition, x ∉ A means ¬ (x ∈ 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, -- This is useful to unfold a let
    push_neg at not_in,
    have lim : limite (λ n, f(x₀ + 1/(n+1))) (f x₀),
    { apply seq_continuous_of_continuous (hf x₀),
      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


import group_theory.subgroup.basic

-- for any type `G` we can define its diagonal type `ΔG={(g,g)|g∈G}`
def Δ (G : Type*) : set (G × G) := { g : G × G | g.fst = g.snd }

-- 14.1
def subgroup_Δ (G : Type*) [group G] : subgroup (G × G) :=
{ carrier := Δ G,
  one_mem' := by { refine rfl, },
  mul_mem' := by { intros a b ga gb,rw Δ at *,finish, },
  inv_mem' := by { intros x hx,rw Δ at *,finish, } }

-- 14.2
theorem normal_Δ_iff_comm (G : Type*) [group G] : (subgroup_Δ G).normal ↔ ∀ g h : G, g * h = h * g :=
begin
  split,
  { intros H g h,
    cases H,
    simp [subgroup_Δ,Δ,*] at *,
    specialize H g g (by refl) g h,
    norm_num at H,
    rw H,
    norm_num,
    exact H,
  },
  {
    intros h,
    fconstructor,
    intros n nsg g,
    simp [subgroup_Δ,Δ,*] at *,
    specialize h g.snd n.snd,
    rw ← h,
    norm_num,
  }
end