/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.order.conditionally_complete_lattice
import Mathlib.ring_theory.multiplicity
import Mathlib.ring_theory.valuation.basic
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-!
# Discrete valuation rings

This file defines discrete valuation rings (DVRs) and develops a basic interface
for them.

## Important definitions

There are various definitions of a DVR in the literature; we define a DVR to be a local PID
which is not a field (the first definition in Wikipedia) and prove that this is equivalent
to being a PID with a unique non-zero prime ideal (the definition in Serre's
book "Local Fields").

Let R be an integral domain, assumed to be a principal ideal ring and a local ring.

* `discrete_valuation_ring R` : a predicate expressing that R is a DVR

### Definitions

* `add_val R : R → ℕ` : the additive valuation on a DVR (sending 0 to 0 rather than the
     mathematically correct +∞).
TODO -- the multiplicative valuation, taking values in something
  like `with_zero (multiplicative ℤ)`?

## Implementation notes

It's a theorem that an element of a DVR is a uniformizer if and only if it's irreducible.
We do not hence define `uniformizer` at all, because we can use `irreducible` instead.

## Tags

discrete valuation ring
-/

/-- An integral domain is a *discrete valuation ring* (DVR) if it's a local PID which
  is not a field. -/
class discrete_valuation_ring (R : Type u) [integral_domain R]
    extends is_principal_ideal_ring R, local_ring R where
  not_a_field' : local_ring.maximal_ideal R ≠ ⊥

namespace discrete_valuation_ring

theorem not_a_field (R : Type u) [integral_domain R] [discrete_valuation_ring R] :
    local_ring.maximal_ideal R ≠ ⊥ :=
  not_a_field'

/-- An element of a DVR is irreducible iff it is a uniformizer, that is, generates the
  maximal ideal of R -/
theorem irreducible_iff_uniformizer {R : Type u} [integral_domain R] [discrete_valuation_ring R]
    (ϖ : R) : irreducible ϖ ↔ local_ring.maximal_ideal R = ideal.span (singleton ϖ) :=
  sorry

/-- Uniformisers exist in a DVR -/
theorem exists_irreducible (R : Type u) [integral_domain R] [discrete_valuation_ring R] :
    ∃ (ϖ : R), irreducible ϖ :=
  sorry

/-- an integral domain is a DVR iff it's a PID with a unique non-zero prime ideal -/
theorem iff_pid_with_one_nonzero_prime (R : Type u) [integral_domain R] :
    discrete_valuation_ring R ↔
        is_principal_ideal_ring R ∧ exists_unique fun (P : ideal R) => P ≠ ⊥ ∧ ideal.is_prime P :=
  sorry

theorem associated_of_irreducible (R : Type u) [integral_domain R] [discrete_valuation_ring R]
    {a : R} {b : R} (ha : irreducible a) (hb : irreducible b) : associated a b :=
  sorry

end discrete_valuation_ring

namespace discrete_valuation_ring

/-- Alternative characterisation of discrete valuation rings. -/
def has_unit_mul_pow_irreducible_factorization (R : Type u_1) [integral_domain R] :=
  ∃ (p : R), irreducible p ∧ ∀ {x : R}, x ≠ 0 → ∃ (n : ℕ), associated (p ^ n) x

namespace has_unit_mul_pow_irreducible_factorization

theorem unique_irreducible {R : Type u_1} [integral_domain R]
    (hR : has_unit_mul_pow_irreducible_factorization R) {p : R} {q : R} (hp : irreducible p)
    (hq : irreducible q) : associated p q :=
  sorry

/-- An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p` is a unique factorization domain.
See `discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization`. -/
theorem to_unique_factorization_monoid {R : Type u_1} [integral_domain R]
    (hR : has_unit_mul_pow_irreducible_factorization R) : unique_factorization_monoid R :=
  sorry

theorem of_ufd_of_unique_irreducible {R : Type u_1} [integral_domain R]
    [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p)
    (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) :
    has_unit_mul_pow_irreducible_factorization R :=
  sorry

end has_unit_mul_pow_irreducible_factorization

theorem aux_pid_of_ufd_of_unique_irreducible (R : Type u) [integral_domain R]
    [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p)
    (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) :
    is_principal_ideal_ring R :=
  sorry

/--
A unique factorization domain with at least one irreducible element
in which all irreducible elements are associated
is a discrete valuation ring.
-/
theorem of_ufd_of_unique_irreducible {R : Type u} [integral_domain R]
    [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p)
    (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) :
    discrete_valuation_ring R :=
  sorry

/--
An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p`
is a discrete valuation ring.
-/
theorem of_has_unit_mul_pow_irreducible_factorization {R : Type u} [integral_domain R]
    (hR : has_unit_mul_pow_irreducible_factorization R) : discrete_valuation_ring R :=
  sorry

theorem associated_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) : ∃ (n : ℕ), associated x (ϖ ^ n) :=
  sorry

theorem eq_unit_mul_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
    ∃ (n : ℕ), ∃ (u : units R), x = ↑u * ϖ ^ n :=
  sorry

theorem ideal_eq_span_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {s : ideal R} (hs : s ≠ ⊥) {ϖ : R} (hirr : irreducible ϖ) :
    ∃ (n : ℕ), s = ideal.span (singleton (ϖ ^ n)) :=
  sorry

theorem unit_mul_pow_congr_pow {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {p : R} {q : R} (hp : irreducible p) (hq : irreducible q) (u : units R) (v : units R) (m : ℕ)
    (n : ℕ) (h : ↑u * p ^ m = ↑v * q ^ n) : m = n :=
  sorry

theorem unit_mul_pow_congr_unit {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {ϖ : R} (hirr : irreducible ϖ) (u : units R) (v : units R) (m : ℕ) (n : ℕ)
    (h : ↑u * ϖ ^ m = ↑v * ϖ ^ n) : u = v :=
  sorry

/-!
## The additive valuation on a DVR
-/

/-- The `ℕ`-valued additive valuation on a DVR (returns junk at `0` rather than `+∞`) -/
def add_val (R : Type u) [integral_domain R] [discrete_valuation_ring R] : R → ℕ :=
  fun (r : R) => dite (r = 0) (fun (hr : r = 0) => 0) fun (hr : ¬r = 0) => classical.some sorry

theorem add_val_spec {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {r : R}
    (hr : r ≠ 0) :
    let ϖ : R := classical.some (exists_irreducible R);
      let n : ℕ :=
        classical.some (associated_pow_irreducible hr (classical.some_spec (exists_irreducible R)));
      associated r (ϖ ^ n) :=
  classical.some_spec (associated_pow_irreducible hr (classical.some_spec (exists_irreducible R)))

theorem add_val_def {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (r : R)
    (u : units R) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) (hr : r = ↑u * ϖ ^ n) : add_val R r = n :=
  sorry

theorem add_val_def' {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (u : units R)
    {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) : add_val R (↑u * ϖ ^ n) = n :=
  add_val_def (↑u * ϖ ^ n) u hϖ n rfl

@[simp] theorem add_val_zero {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] :
    add_val R 0 = 0 :=
  dif_pos rfl

@[simp] theorem add_val_one {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] :
    add_val R 1 = 0 :=
  sorry

@[simp] theorem add_val_uniformizer {R : Type u_1} [integral_domain R] [discrete_valuation_ring R]
    {ϖ : R} (hϖ : irreducible ϖ) : add_val R ϖ = 1 :=
  sorry

@[simp] theorem add_val_mul {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R}
    {b : R} (ha : a ≠ 0) (hb : b ≠ 0) : add_val R (a * b) = add_val R a + add_val R b :=
  sorry

theorem add_val_pow {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (a : R) (n : ℕ) :
    add_val R (a ^ n) = n * add_val R a :=
  sorry

theorem add_val_le_iff_dvd {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R}
    {b : R} (ha : a ≠ 0) (hb : b ≠ 0) : add_val R a ≤ add_val R b ↔ a ∣ b :=
  sorry

theorem add_val_add {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R} {b : R}
    (ha : a ≠ 0) (hb : b ≠ 0) (hab : a + b ≠ 0) :
    min (add_val R a) (add_val R b) ≤ add_val R (a + b) :=
  sorry

end Mathlib


import data.set
import data.stream.defs data.stream.init
import data.pnat.basic
import tactic
open stream

structure LTS:= (S : Type) (Act : Type)
(TR : set (S × Act × S))
--structure LTS:= (S : Type) (A : Type) (Δ : set (S × Act × S))

@[ext]
structure path (M : LTS) :=
(init : M.S)
(s : stream (M.Act × M.S))
(sound : ((init, (s 0).1, (s 0).2) ∈ M.TR) ∧
          ∀ i : ℕ, ((s i).2, (s (i+1)).1, (s (i+1)).2) ∈ M.TR)

variable {M : LTS}

namespace path

def index (π : path M) : ℕ+ → (M.Act × M.S)
| (n) := (π.s (n-1))

def action (π : path M) (n : ℕ) : M.Act :=
(π.index (⟨n+1, by {exact nat.succ_pos n,}⟩)).1

def state (π : path M) (n : ℕ) : M.S :=
(π.index (⟨n+1, by {exact nat.succ_pos n,}⟩)).2

lemma drop_aux (π : path M) (n : ℕ) :
    ((π.s n).snd, (drop (n+1) π.s 0).fst, (drop (n+1) π.s 0).snd) ∈ M.TR ∧ ∀ (i : ℕ), ((drop (n+1) π.s i).snd, (stream.drop (n+1) π.s (i + 1)).fst, (drop (n+1) π.s (i + 1)).snd) ∈ M.TR :=
    begin
         have := π.sound, cases this with L R,
         rw stream.drop,
         dsimp at *, simp at *,
         split,
         apply R n,
         intro i,
         replace R := R (i+n.succ),
         rw add_assoc at R, rw add_comm n.succ 1 at R, rw ← add_assoc at R,
         apply R,
end

def drop (π : path M) : ℕ → path M
| 0 := π
| (nat.succ n) :=
    path.mk (π.s n).2 (π.s.drop n.succ) (drop_aux π n)

@[simp]
lemma foo {s0 : M.S} {σ : stream (M.Act × M.S)} {pf : ((s0, (σ 0).1, (σ 0).2) ∈ M.TR) ∧ ∀ i : ℕ, ((σ i).2, (σ (i+1)).1, (σ (i+1)).2) ∈ M.TR} {i : ℕ} : (path.drop {path. init := s0, s := σ, sound := pf} i).s = (σ.drop i) :=
begin
    cases i,
    refl,
    refl,
end

lemma drop_drop  (π : path M) {i j : ℕ} :
    (π.drop i).drop j = π.drop (i+j) :=
    begin
        induction j with j IH,
        refl,
        cases π with s0 σ prf,
        cases prf with L R,
        unfold path.drop,
        simp,
        ext,
        unfold stream.drop,
        simp,
        rw nat.add_succ,
        rw path.drop,
        simp [add_comm],
        simp, rw stream.drop_drop,
        rw add_comm,
        rw nat.add_succ,
        rw path.drop,
        simp,
        rw stream.drop_drop,
        rw add_comm, rw ← nat.add_succ,
    end

-- lemma drop_drop  (π : path M) {i j : ℕ} :
--     (π.drop i).drop j = π.drop (i+j) :=
--     begin
--         cases i, {rw drop, simp},
--         cases j, rw [drop,drop],
--         rw drop, rw drop, simp,
--         rw stream.drop_drop,
--          split,
--         rw stream.drop,
--         simp, rw add_comm,
--         rw nat.add_succ,
--         rw add_comm, rw nat.add_succ,
--         rw add_comm i.succ,
--         rw nat.add_succ, rw add_comm,
--     end

end path

inductive formula (M : LTS)
| T : formula
| state_predicate (p : M.S → Prop) : formula
| act_predicate (p : M.Act → Prop) : formula
| states (s : set M.S) : formula
| acts (a : set M.Act) : formula
| neg (x : formula) : formula
| conj (φ₁ φ₂ : formula) : formula
| disj (φ₁ φ₂ : formula) : formula
| impl (φ₁ φ₂ : formula) : formula
| next (φ : formula) : formula
| always (φ : formula) : formula
| eventually (φ : formula) : formula
| until (φ₁ φ₂ : formula) : formula

def sat {M : LTS} : formula M → path M → Prop
| formula.T := λ _, true
| (formula.states s) :=  λ π, π.init ∈  s
| (formula.acts a)  := λ π, (path.index π 1).1 ∈ a
| (formula.neg φ) := λ π, ¬ (sat φ) π
| (formula.conj φ₁ φ₂) := λ π, sat φ₁ π ∧ sat φ₂ π
| (formula.disj φ₁ φ₂) := λ π, sat φ₁ π ∨ sat φ₂ π
| (formula.impl φ₁ φ₂) := λ π, sat φ₁ π → sat φ₂ π
| (formula.next φ) := λ π, sat φ (π.drop 1)
| (formula.until φ₁ φ₂) := λ π,
    ∃ j, sat φ₂ (π.drop j) ∧ (∀ i < j, sat φ₁ (π.drop i))
| (formula.always φ) := λ π, ∀ i, sat φ (π.drop i)
| (formula.eventually φ) := λ π, ∃ i, sat φ (π.drop i)
| (formula.state_predicate p) := λ π, p π.init
| (formula.act_predicate p) := λ π, p (path.index π 1).1

notation φ ` & ` ψ := formula.conj  φ ψ
notation φ ` ⅋ ` ψ := formula.disj φ ψ
notation ` !` φ := formula.neg φ
notation φ ` U ` ψ := formula.until φ ψ
notation ` ◆` φ := formula.eventually φ
notation ` ◾` φ  := formula.always  φ
notation φ ` ⇒ ` ψ := formula.impl φ ψ
notation π `⊨` P := sat P π

namespace formula

def weak_until (φ ψ : formula M) : formula M :=
(◾φ) ⅋ (φ U ψ)

end formula

notation φ ` W ` ψ := formula.weak_until φ ψ

namespace sat

lemma  weak_until (φ ψ : formula M) (π : path M) :
    sat (formula.weak_until φ ψ) π ↔ sat (◾ φ) π ∨ sat (φ U ψ) π :=
  by {rw formula.weak_until, repeat {rw sat}}

end sat

lemma push_neg_tok {M : LTS} {π : path M} : ∀ P : formula M,
    ¬ (sat P π) ↔ sat (!P) π :=
by {intro P, refl,}

lemma always_eventually_dual (P : formula M) (π : path M) :
    sat (◾!P) π ↔ (¬ sat (◆P) π) :=
by {repeat {rw sat}, tidy}

@[simp] lemma succ_add_1 {π : path M} {i : ℕ} :
 (π.drop i).drop 1 = π.drop (i.succ) :=
 by {rw path.drop_drop}


import analysis.real tactic.ring tactic.interactive
import seq naturally background binomial

namespace problem1

noncomputable theory

lemma converges_of_bdd_not_decr (s : seq ℝ) :
  bdd_above {x : ℝ | ∃ n, x = s n} → (∀ n, s n ≤ s (n+1)) → converges s := sorry

lemma converges_to_cSup (s : seq ℝ) : (∀ n, s n ≤ s (n+1)) → converges_to s (lattice.Sup {x : ℝ | ∃ n, x = s n}) := sorry

def a : seq ℝ := shift 1 $ λ n, (1+1/n)^n
def b : seq ℝ := shift 1 $ λ n, (1+1/n)^(n+1)
def I : seq (set ℝ) := λ n, set.Icc (a n) (b n)

def b_rat : seq ℚ := shift 1 $ λ n, (1+1/n)^(n+1)
def e_seq : seq ℚ := shift 1 $ λ n, (1+1/n)^n

lemma rat.cast_pow {α : Type} [division_ring α] [char_zero α] :
  ∀ a : ℚ, ∀ n : ℕ, ((a^n : ℚ) : α) = (a : α)^n :=
  begin
  intros,
  induction n with n ih,
  simpa,
  simp [has_pow.pow, monoid.pow] at *,
  rw ih,
  end

example : a = coe ∘ e_seq :=
  begin
  apply funext, intro n,
  simp [e_seq, a, shift],
  rwa
    [ rat.cast_pow
    , rat.cast_add
    , rat.cast_one
    , rat.cast_inv
    , rat.cast_add
    , rat.cast_one
    , rat.cast_coe_nat
    ],
  end

lemma binomial_e_seq : ∀ n, e_seq n = binomial.expansion 1 (1/(n+1)) (n+1) :=
  λ n, binomial_theorem 1 (1/(n+1)) (n+1)

lemma binomial_b_rat : ∀ n, b_rat n = binomial.expansion 1 (1/(n+1)) (n+2) :=
  λ n, binomial_theorem 1 (1/(n+1)) (n+2)

def e_seq_incr : ∀ n, e_seq (n+1) > e_seq n :=
  begin
  intro,
  end

-- #check @add_le_add

lemma list.sum_map_le {α : Type} {l : list α} {f g : α → ℚ} :
  (∀ e ∈ l, f e ≤ g e) →
  list.sum (list.map f l) ≤ list.sum (list.map g l) :=
  begin
  intro ha,
  induction l with l0 l ih, simp,
  simp,
  apply add_le_add,
  apply ha, left, refl,
  apply ih, intros e m, apply ha, right, exact m,
  end

lemma helper' {α : Type} {l : list α} {f g : α → ℚ} {c : ℚ} :
  (∃ e ∈ l, c + f e < g e) →
  (∀ e ∈ l, f e ≤ g e) →
  c + list.sum (list.map f l) < list.sum (list.map g l) :=
  begin
  intros he ha,
  induction l with l0 l ih,
  exfalso,
  apply exists.elim he,
  intros e e_mem_nil,
  apply exists.elim e_mem_nil,
  intros e_mem_nil _,
  exact list.not_mem_nil e e_mem_nil,
  simp at he |-,
  apply exists.elim he,
  rintro e ⟨e_here | e_there, e_prop⟩,
  rw e_here at e_prop,
  rw [← add_assoc],
  apply lt_of_le_of_lt,
  apply add_le_add_left,
  show list.sum (list.map f l) ≤ list.sum (list.map g l),
  apply list.sum_map_le,
  intros e m, apply ha, right, exact m,
  apply add_lt_add_right,
  assumption,
  rw [← add_assoc, add_comm c, add_assoc],
  apply lt_of_lt_of_le,
  apply add_lt_add_left,
  apply ih,
  existsi e, existsi e_there, exact e_prop,
  intros e m, apply ha, right, exact m,
  apply add_le_add_right,
  apply ha, left, refl,
  end

@[simp] lemma B_1 : ∀ n, B n 1 = n :=
  begin
  intro n,
  induction n with n ih,
  refl,
  simp [B], rw ih, ring,
  end

@[simp] lemma B_2 : ∀ n, B (n+2) 2 = ((n+2) * (n+1))/2 :=
  begin
  intro n,
  induction n with n ih,
  refl,
  unfold1 B, rw [B_1, ih],
  admit,
  end

-- I stumbled upon the fact that this is true for all n=i
-- It says that one item in the list is sufficiently smaller
-- than the corresponding term in the other list
-- to offset the extra term
#eval ((λ (n i : ℕ), (2 + ↑n : ℚ)⁻¹ ^ (n + 3) + ↑(B (n + 3) (nat.succ i)) * (1 + (1 + ↑n))⁻¹ ^ (n + 2 - i) <
    ↑(B (n + 2) i) * (1 + ↑n)⁻¹ ^ (n + 2 - i)) 6 6 : bool)

def blah (n : ℕ) :
  (2 + ↑n : ℚ)⁻¹ ^ (n + 3) +
  ↑(B (n + 3) (n + 1)) * (1 + (1 + ↑n))⁻¹ ^ (n + 2 - n) <
    ↑(B (n + 2) n) * (1 + ↑n)⁻¹ ^ (n + 2 - n) :=
  begin
  ring,
  rw [B.symm (by norm_num : n+1≤n+3), B.symm (by norm_num : n≤n+2)],
  simp [nat.add_sub_cancel_left],
  admit,
  -- Reasoning:
  --   B (n+3) (n+1) * ((n+2)⁻¹ ^ 2) = (n+3)*(n+2)/2 * ((n+2)⁻¹ ^ 2)
  -- and
  --   B (n+2) n * (n+1)⁻¹ ^ 2 = (n+2)*(n+1)/2 * ((n+1)⁻¹ ^ 2)
  -- So we want
  --   (n+2)⁻¹ ^ (n+3) + (n+3)*(n+2)/2 * ((n+2)⁻¹ ^ 2) < (n+2)*(n+1)/2 * ((n+1)⁻¹ ^ 2)
  -- Clear the (positive) denominators:
  --   2*(n+1)*((n+2)⁻¹ ^ (n+2)) + (n+3)*(n+1) < (n+2)^2
  --   ---------/-----/--------- + n^2 + 4*n + 3 < n^2 + 4*n + 4
  -- And we have
  --   2*(n+1)*((n+2)⁻¹ ^ (n+2))
  -- = 2*((n+1)/(n+2))*((n+2)⁻¹ ^ (n+1))
  -- = 2*((n+2)⁻¹ ^ (n+1))*((n+1)/(n+2))
  -- ≤ 2*(1/2)*((n+1)/(n+2))
  -- = 1*(n+1)/(n+2)
  -- < 1*1 = 1
  -- So this is done.
  end

-- Hm
#eval (λ n i, (B (n + 3) (nat.succ i) : ℚ) * (↑n + 2)⁻¹ ^ (n + 2 - i)
    ≤ ↑(B (n + 2) i) * (↑n + 1)⁻¹ ^ (n + 2 - i) : ℕ → ℕ → bool) 1 0

def b_rat_decr : ∀ n, b_rat (n+1) < b_rat n :=
  begin
  intro n,
  rw [binomial_b_rat, binomial_b_rat],
  unfold binomial.expansion,
  rw [list.range_succ_eq_map],
  simp, ring,
  suffices : (∃ i ∈ list.range (n+3),
    (n + 2 : ℚ)⁻¹ ^ (n + 3) +
      ((λ (i : ℕ), (B (n + 3) i : ℚ) * (1 + (1 + ↑n))⁻¹ ^ (n + 3 - i)) ∘ nat.succ) i
    < (λ (i : ℕ), (B (n + 2) i : ℚ) * (1 + ↑n)⁻¹ ^ (n + 2 - i)) i)
    ∧ (∀ i ∈ list.range (n+3),
      ((λ (i : ℕ), (B (n + 3) i : ℚ) * (1 + (1 + ↑n))⁻¹ ^ (n + 3 - i)) ∘ nat.succ) i
    ≤ (λ (i : ℕ), (B (n + 2) i : ℚ) * (1 + ↑n)⁻¹ ^ (n + 2 - i)) i),
    {
      exact helper' this.1 this.2,
    },
  simp,
  constructor,
  existsi n,
  constructor,
  norm_num,
  exact blah n,
  intros i i_mem,
  ring,
  show (B (n + 3) (i + 1) : ℚ) * (↑n + 2)⁻¹ ^ (n + 2 - i)
    ≤ ↑(B (n + 2) i) * (↑n + 1)⁻¹ ^ (n + 2 - i),
  -- have: n+2-i ≥ 0
  -- B (n+3) (i+1) * (n+2)⁻¹ ^ (n+2-i)
  -- = list.prod (list.map (λ j, (n+3-j)/(n+2)) (list.range (n+2-i)))
  -- B (n+2) i * (n+1)⁻¹ ^ (n+2-i)
  -- = list.prod (list.map (λ j, (n+2-j)/(n+1)) (list.range (n+2-i)))
  -- and we have
  -- ∀ j ∈ list.range (n+2-i),
  --    (n+3-j)/(n+2) ≤ (n+2-j)/(n+1)
  --  ↔ (n+1)(n+3-j) ≤ (n+2)(n+2-j)
  --  ↔ n^2 + 4*n + 3 - j*(n+1) ≤ n^2 + 4*n + 4 - j*(n+2)
  --  ↔ j ≤ 1
  -- nope, that's not right
  -- I give up ...
  end

def real.e : ℝ := quotient.mk ⟨e_seq,
  begin
  have binomial_b_rat := binomial_b_rat,
  simp [binomial.expansion, list.range_succ_eq_map] at binomial_b_rat,
  intros ε ε_pos,
  admit,
  end⟩

-- ∀ n, b n = a n * (1 + 1/(n+1)) > a n
-- intervals are properly nested since a n increasing, b n decreasing (unproven)
-- thus (set.Inter I = {real.e}), because e is obviously the supremum of
-- the set of a n terms and the infimum of b n terms, since their difference goes to 0

lemma converge : converges_to (a - b) 0 :=
  begin
  rw [converges_to.def],
  have : ∀ (n : ℕ), (a - b) n = (1 + (1 + n : ℝ)⁻¹) ^ (n + 1) * (1 - (1 + (1 + n : ℝ)⁻¹)),
    intro n,
    change (a - b) n with a n - b n,
    unfold a b shift,
    rw
      [ one_div_eq_inv
      , nat.cast_succ
      , add_comm (1 : ℝ) (n : ℝ)
      , mul_sub_left_distrib
      , pow_succ _ (n+1)
      , mul_one
      , mul_comm
      ],
  simp only [this],
  rw [← converges_to.def, ← mul_zero],
  apply converges_to.prod,
  admit, -- a n converges to real.e
  simp,
  admit, -- and -(1 + ↑n)⁻¹ converges to 0, obviously
  exact real.e,
  end

end problem1

namespace problem2

def group_by {α : Type} [topological_space α] [add_monoid α]
  (s : seq α) (n : seq ℕ) : seq α
  | 0 := list.sum (s <$> list.range' 0 (n 0))
  | (i+1) := list.sum (s <$> list.range' (n i) (n (i+1) - n i))

-- This says that summing the terms of s from 0 to n i
-- is the same as summing the terms of (group_by s n) from 0 to i+1
-- (where n must be an increasing function; encoded here as a subsequence of id)
lemma group_by.prop {α : Type} [topological_space α] [add_monoid α]
  (s : seq α) (n : seq ℕ) (Hn : is_subsequence_of (@id ℕ) n) : ∀ i,
  seq.sum s (n i) = seq.sum (group_by s n) (i+1) :=
  begin
  have monotone : ∀ a b, a < b → n a < n b,
    begin
    apply exists.elim Hn,
    rintros f ⟨monote, f_eq_n⟩,
    simp only [id] at f_eq_n,
    have : f = n := funext f_eq_n,
    simp [this] at monote,
    exact monote,
    end,
  intro i,
  unfold seq.sum,
  induction i with i ih,
  simp [list.range, list.range_core, group_by],
  rw [← list.range_eq_range'],
  refl,
  -- rw [list.range'_eq_map_range],
  have range_split : ∀ j, list.range (n (nat.succ j)) = list.range (n j) ++ list.range' (n j) (n (nat.succ j) - n j) :=
    begin
    intro j,
    rw [list.range_eq_range'],
    rw [list.range_eq_range'],
    rw [← zero_add (n j)] { occs := occurrences.pos [2] },
    rw [list.range'_append],
    congr,
    rw [add_comm _ (n _)], symmetry,
    apply nat.add_sub_cancel',
    apply le_of_lt,
    apply monotone,
    apply nat.lt_succ_self,
    end,
  have sum_split : list.sum (s <$> list.range (n (nat.succ i))) =
    list.sum (s <$> list.range (n i)) + list.sum (s <$> list.range' (n i) (n (i+1) - n i)),
    begin
    simp,
    rw [← list.sum_append],
    rw [← list.map_append s],
    congr,
    exact range_split i,
    end,
  transitivity, exact sum_split,
  rw ih,
  have : list.range (nat.succ i + 1) = list.range' 0 (nat.succ i) ++ list.range' (nat.succ i) 1,
    begin
    rw [add_comm],
    rw [← zero_add (nat.succ i)] { occs := occurrences.pos [3] },
    rw [list.range_eq_range'],
    symmetry,
    apply list.range'_append,
    end,
  rw this,
  unfold functor.map,
  rw [list.map_append, list.sum_append],
  congr' 1,
  rw [list.range_eq_range'],
  unfold list.range',
  rw [list.map_singleton, list.sum_cons, list.sum_nil],
  simp [group_by],
  end

lemma proof {α : Type} [metric_space α] [add_monoid α]
  (s : seq α) (l : α)
  (Hs : converges_to (seq.sum s) l)
  -- it's kind of funny that "a subsequence of ℕ" really means
  -- "a subsequence of @id ℕ"
  (n : seq ℕ) (Hn : is_subsequence_of (@id ℕ) n) :
  converges_to (seq.sum (group_by s n)) l :=
  begin
  suffices : converges_to (shift 1 (seq.sum (group_by s n))) l,
    rw [shift.converges_to], exact this,
  rw [converges_to.def] at *,
  intros,
  apply Exists.imp _ (Hs ε H),
  intros a this,
  intros i i_ge_a,
  have monotone : ∀ a b, a < b → n a < n b,
    begin
    apply exists.elim Hn,
    rintros f ⟨monote, f_eq_n⟩,
    simp only [id] at f_eq_n,
    have : f = n := funext f_eq_n,
    simp [this] at monote,
    exact monote,
    end,
  have := this (n i)
    begin
    suffices : ∀ j, n j ≥ j,
      transitivity, apply this, exact i_ge_a,
    intro j,
    induction j with j ih,
    apply nat.zero_le,
    suffices : n (j+1) > n j,
      apply nat.succ_le_of_lt,
      apply lt_of_le_of_lt,
      exact ih, exact this,
    apply monotone,
    apply nat.lt_succ_self,
    end,
  suffices e : seq.sum s (n i) = seq.sum (group_by s n) (i+1),
    rw e at this, exact this,
  apply group_by.prop,
  assumption,
  end

end problem2

namespace problem3

-- Explanation:
-- group_by effects the "adding of parentheses"
-- by grouping many terms of the original series
-- under one term of the new series
-- (thus evaluation will seem to skip many indices
-- of the original sequence); adding even
-- infinite parentheses would produce the same effect,
-- since each top-level parenthesis group counts for one term.

end problem3

namespace problem4

-- This pairs the terms in a sum like
-- (a 0 + a 1) + (a 2 + a 3) + ···
def pairs {α : Type} [has_add α] (s : seq α) : seq α :=
  λ n, s (2*n) + s (2*n+1)

-- This goes 1 - 1 + 1 - 1 + ···
def a : seq ℤ := seq.sum signed
-- This goes (1 - 1) + (1 - 1) + ···
def pairs_a : seq ℤ := seq.sum (pairs signed)

lemma pairs_a_conv : converges_to pairs_a 0 :=
  begin
  -- It is enough to prove that each term is equal to 0
  suffices : ∀ n, pairs signed n = 0,
    begin
    rw [converges_to.def],
    intros, existsi 0, intros,
    -- because then the sum is equal to zero
    have : pairs_a n = 0,
      begin
      unfold pairs_a seq.sum,
      -- `list.repeat` means a list of fixed terms (viz. 0)
      rw [(@list.eq_repeat' ℤ 0 (pairs signed <$> list.range n)).2 _],
      -- so its sum unfolds to a (additive monoid) multiplication of the term
      rwa [list.sum_repeat, add_monoid.smul_zero],
      -- just proving that each term is 0
      simp, intros _ i _ _, have := this i, cc
      end,
    rw [this, dist_self], assumption,
    end,
  intro n,
  unfold pairs a seq.sum,
  rw [signed_even, signed_odd],
  simp,
  end

-- This obvious instance needs to be added
-- for converges_to_zero_of_sum_converges
instance int.normed_group : normed_group ℤ :=
{ norm := λ a, norm (coe a : ℝ)
, dist_eq :=
  begin
  intros,
  change dist x y with dist (coe x) (coe y),
  simp [norm, dist_eq_norm],
  end
}

-- This sum diverges, since its terms do not go to 0
lemma a_div : ¬converges a :=
  begin
  by_contradiction conv,
  have := converges_to_zero_of_sum_converges conv,
  rw [converges_to.def] at this,
  -- (1/2) is the easiest 0 < ε < 1
  have := this (1/2) one_half_pos,
  apply exists.elim this, intros N this,
  -- similarly N is the easiest n ≥ N
  have := this N (le_refl N),
  -- simplify ∥1∥, used below
  -- relies on the above instance defining it via coe
  -- (under the hood it has to convert
  -- norm (1 : ℤ) to norm (1 : ℝ), which is defeq)
  have norm_one : norm (1 : ℤ) = 1 :=
    eq.trans (real.norm_eq_abs 1) abs_one,
  -- the semicolon essentially means keep solving
  -- each case with a similar line of argument
  cases signed_cases N;
    -- reduced it to 1 < 2⁻¹
    simp [h, norm_one] at this;
    apply not_lt_of_gt this;
    -- but 2⁻¹ < 1, in fact
    simpa using (@one_half_lt_one ℝ _)
  end

end problem4


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

import for_mathlib.dold_kan.functor_n

/-!

# Comparison with the normalized Moore complex functor

TODO (@joelriou) continue adding the various files referenced below

In this file, we show that when the category `A` is abelian,
there is an isomorphism `N₁_iso_normalized_Moore_complex_comp_to_karoubi` between
the functor `N₁ : simplicial_object A ⥤ karoubi (chain_complex A ℕ)`
defined in `functor_n.lean` and the composition of
`normalized_Moore_complex A` with the inclusion
`chain_complex A ℕ ⥤ karoubi (chain_complex A ℕ)`.

This isomorphism shall be used in `equivalence.lean` in order to obtain
the Dold-Kan equivalence
`category_theory.abelian.dold_kan.equivalence : simplicial_object A ≌ chain_complex A ℕ`
with a functor (definitionally) equal to `normalized_Moore_complex A`.

-/

open category_theory category_theory.category category_theory.limits
  category_theory.subobject category_theory.idempotents
open_locale dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

universe v

variables {A : Type*} [category A] [abelian A] {X : simplicial_object A}

lemma higher_faces_vanish.inclusion_of_Moore_complex_map (n : ℕ) :
  higher_faces_vanish (n+1) ((inclusion_of_Moore_complex_map X).f (n+1)) := λ j hj,
begin
  dsimp [inclusion_of_Moore_complex_map],
  rw [← factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ
    _ j (by simp only [finset.mem_univ])), assoc, kernel_subobject_arrow_comp, comp_zero],
end

lemma factors_normalized_Moore_complex_P_infty (n : ℕ) :
  subobject.factors (normalized_Moore_complex.obj_X X n) (P_infty.f n) :=
begin
  cases n,
  { apply top_factors, },
  { rw [P_infty_f, normalized_Moore_complex.obj_X, finset_inf_factors],
    intros i hi,
    apply kernel_subobject_factors,
    exact (higher_faces_vanish.of_P (n+1) n) i (le_add_self), }
end

/-- P_infty factors through the normalized Moore complex -/
@[simps]
def P_infty_to_normalized_Moore_complex (X : simplicial_object A) : K[X] ⟶ N[X] :=
chain_complex.of_hom _ _ _ _ _ _
  (λ n, factor_thru _ _ (factors_normalized_Moore_complex_P_infty n))
  (λ n, begin
    rw [← cancel_mono (normalized_Moore_complex.obj_X X n).arrow, assoc, assoc,
      factor_thru_arrow, ← inclusion_of_Moore_complex_map_f,
      ← normalized_Moore_complex_obj_d, ← (inclusion_of_Moore_complex_map X).comm' (n+1) n rfl,
      inclusion_of_Moore_complex_map_f, factor_thru_arrow_assoc,
      ← alternating_face_map_complex_obj_d],
    exact P_infty.comm' (n+1) n rfl,
  end)

@[simp, reassoc]
lemma P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map
  (X : simplicial_object A) :
  P_infty_to_normalized_Moore_complex X ≫ inclusion_of_Moore_complex_map X = P_infty := by tidy

@[simp, reassoc]
lemma P_infty_to_normalized_Moore_complex_naturality {X Y : simplicial_object A} (f : X ⟶ Y) :
  alternating_face_map_complex.map f ≫ P_infty_to_normalized_Moore_complex Y =
    P_infty_to_normalized_Moore_complex X ≫ normalized_Moore_complex.map f := by tidy

@[simp, reassoc]
lemma P_infty_comp_P_infty_to_normalized_Moore_complex (X : simplicial_object A) :
  P_infty ≫ P_infty_to_normalized_Moore_complex X = P_infty_to_normalized_Moore_complex X :=
by tidy

@[simp, reassoc]
lemma inclusion_of_Moore_complex_map_comp_P_infty (X : simplicial_object A) :
  inclusion_of_Moore_complex_map X ≫ P_infty = inclusion_of_Moore_complex_map X :=
begin
  ext n,
  cases n,
  { dsimp, simp only [comp_id], },
  { exact (higher_faces_vanish.inclusion_of_Moore_complex_map n).comp_P_eq_self, },
end

@[simp, reassoc]
lemma inclusion_of_Moore_complex_map_comp_Q_infty (X : simplicial_object A) :
  inclusion_of_Moore_complex_map X ≫ Q_infty = 0 :=
begin
  dsimp only [Q_infty],
  simpa only [preadditive.comp_sub, inclusion_of_Moore_complex_map_comp_P_infty, sub_eq_zero]
    using comp_id _,
end

instance : mono (inclusion_of_Moore_complex_map X) :=
⟨λ Y f₁ f₂ hf, by { ext n, exact homological_complex.congr_hom hf n, }⟩

/-- `inclusion_of_Moore_complex_map X` is a split mono. -/
def split_mono_inclusion_of_Moore_complex_map (X : simplicial_object A) :
  split_mono (inclusion_of_Moore_complex_map X) :=
{ retraction := P_infty_to_normalized_Moore_complex X,
  id' := by simp only [← cancel_mono (inclusion_of_Moore_complex_map X), assoc, id_comp,
    P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map,
    inclusion_of_Moore_complex_map_comp_P_infty], }

variable (A)

/-- When the category `A` is abelian,
the functor `N₁ : simplicial_object A ⥤ karoubi (chain_complex A ℕ)` defined
using `P_infty` identifies to the composition of the normalized Moore complex functor
and the inclusion in the Karoubi envelope. -/
def N₁_iso_normalized_Moore_complex_comp_to_karoubi :
  N₁ ≅ (normalized_Moore_complex A ⋙ to_karoubi _) :=
{ hom :=
  { app := λ X,
    { f := P_infty_to_normalized_Moore_complex X,
      comm := by tidy, }, },
  inv :=
  { app := λ X,
    { f := inclusion_of_Moore_complex_map X,
      comm := by tidy, }, },
  hom_inv_id' := begin
    ext X : 3,
    simp only [P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map,
      nat_trans.comp_app, karoubi.comp_f, N₁_obj_p, nat_trans.id_app, karoubi.id_eq],
  end,
  inv_hom_id' := begin
    ext X : 3,
    simp only [← cancel_mono (inclusion_of_Moore_complex_map X),
      nat_trans.comp_app, karoubi.comp_f, assoc, nat_trans.id_app, karoubi.id_eq,
      P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map,
      inclusion_of_Moore_complex_map_comp_P_infty],
    dsimp only [functor.comp_obj, to_karoubi],
    rw id_comp,
  end }

end dold_kan

end algebraic_topology


import data.real.basic

-- BEGIN
example :
  ¬ ∀ {f : ℝ → ℝ}, monotone f → ∀ {a b}, f a ≤ f b → a ≤ b :=
begin
  intro h,
  let f := λ x : ℝ, (0 : ℝ),
  have monof : monotone f,
  { intros a b hab,
  exact rfl.ge, },
  have h1 : f 1 ≤ f 0,
    from le_refl _,
  have h2 : (1 : ℝ) ≤ 0 := h monof h1,
  exact not_lt_of_le h2 zero_lt_one,
end

-- END


/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Johan Commelin
-/

import ring_theory.graded_algebra.homogeneous_ideal
import topology.category.Top.basic
import topology.sets.opens

/-!
# Projective spectrum of a graded ring

The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals that
are prime and do not contain the irrelevant ideal.
It is naturally endowed with a topology: the Zariski topology.

## Notation
- `R` is a commutative semiring;
- `A` is a commutative ring and an `R`-algebra;
- `𝒜 : ℕ → submodule R A` is the grading of `A`;

## Main definitions

* `projective_spectrum 𝒜`: The projective spectrum of a graded ring `A`, or equivalently, the set of
  all homogeneous ideals of `A` that is both prime and relevant i.e. not containing irrelevant
  ideal. Henceforth, we call elements of projective spectrum *relevant homogeneous prime ideals*.
* `projective_spectrum.zero_locus 𝒜 s`: The zero locus of a subset `s` of `A`
  is the subset of `projective_spectrum 𝒜` consisting of all relevant homogeneous prime ideals that
  contain `s`.
* `projective_spectrum.vanishing_ideal t`: The vanishing ideal of a subset `t` of
  `projective_spectrum 𝒜` is the intersection of points in `t` (viewed as relevant homogeneous prime
  ideals).
* `projective_spectrum.Top`: the topological space of `projective_spectrum 𝒜` endowed with the
  Zariski topology.
-/

noncomputable theory
open_locale direct_sum big_operators pointwise
open direct_sum set_like Top topological_space category_theory opposite

variables {R A: Type*}
variables [comm_semiring R] [comm_ring A] [algebra R A]
variables (𝒜 : ℕ → submodule R A) [graded_algebra 𝒜]

/-- The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals
that are prime and do not contain the irrelevant ideal. -/
@[ext, nolint has_nonempty_instance] structure projective_spectrum :=
(as_homogeneous_ideal : homogeneous_ideal 𝒜)
(is_prime : as_homogeneous_ideal.to_ideal.is_prime)
(not_irrelevant_le : ¬(homogeneous_ideal.irrelevant 𝒜 ≤ as_homogeneous_ideal))

attribute [instance] projective_spectrum.is_prime

namespace projective_spectrum

/-- The zero locus of a set `s` of elements of a commutative ring `A` is the set of all relevant
homogeneous prime ideals of the ring that contain the set `s`.

An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`.
At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the
quotient ring `A` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset
of `projective_spectrum 𝒜` where all "functions" in `s` vanish simultaneously. -/
def zero_locus (s : set A) : set (projective_spectrum 𝒜) :=
{x | s ⊆ x.as_homogeneous_ideal}

@[simp] lemma mem_zero_locus (x : projective_spectrum 𝒜) (s : set A) :
  x ∈ zero_locus 𝒜 s ↔ s ⊆ x.as_homogeneous_ideal := iff.rfl

@[simp] lemma zero_locus_span (s : set A) :
  zero_locus 𝒜 (ideal.span s) = zero_locus 𝒜 s :=
by { ext x, exact (submodule.gi _ _).gc s x.as_homogeneous_ideal.to_ideal }

variable {𝒜}
/-- The vanishing ideal of a set `t` of points of the projective spectrum of a commutative ring `R`
is the intersection of all the relevant homogeneous prime ideals in the set `t`.

An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`.
At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the
quotient ring `A` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the
ideal of `A` consisting of all "functions" that vanish on all of `t`. -/
def vanishing_ideal (t : set (projective_spectrum 𝒜)) : homogeneous_ideal 𝒜 :=
⨅ (x : projective_spectrum 𝒜) (h : x ∈ t), x.as_homogeneous_ideal

lemma coe_vanishing_ideal (t : set (projective_spectrum 𝒜)) :
  (vanishing_ideal t : set A) =
  {f | ∀ x : projective_spectrum 𝒜, x ∈ t → f ∈ x.as_homogeneous_ideal} :=
begin
  ext f,
  rw [vanishing_ideal, set_like.mem_coe, ← homogeneous_ideal.mem_iff,
    homogeneous_ideal.to_ideal_infi, submodule.mem_infi],
  apply forall_congr (λ x, _),
  rw [homogeneous_ideal.to_ideal_infi, submodule.mem_infi, homogeneous_ideal.mem_iff],
end

lemma mem_vanishing_ideal (t : set (projective_spectrum 𝒜)) (f : A) :
  f ∈ vanishing_ideal t ↔
  ∀ x : projective_spectrum 𝒜, x ∈ t → f ∈ x.as_homogeneous_ideal :=
by rw [← set_like.mem_coe, coe_vanishing_ideal, set.mem_set_of_eq]

@[simp] lemma vanishing_ideal_singleton (x : projective_spectrum 𝒜) :
  vanishing_ideal ({x} : set (projective_spectrum 𝒜)) = x.as_homogeneous_ideal :=
by simp [vanishing_ideal]

lemma subset_zero_locus_iff_le_vanishing_ideal (t : set (projective_spectrum 𝒜))
  (I : ideal A) :
  t ⊆ zero_locus 𝒜 I ↔ I ≤ (vanishing_ideal t).to_ideal :=
⟨λ h f k, (mem_vanishing_ideal _ _).mpr (λ x j, (mem_zero_locus _ _ _).mpr (h j) k), λ h,
  λ x j, (mem_zero_locus _ _ _).mpr (le_trans h (λ f h, ((mem_vanishing_ideal _ _).mp h) x j))⟩

variable (𝒜)
/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc_ideal : @galois_connection
  (ideal A) (set (projective_spectrum 𝒜))ᵒᵈ _ _
  (λ I, zero_locus 𝒜 I) (λ t, (vanishing_ideal t).to_ideal) :=
λ I t, subset_zero_locus_iff_le_vanishing_ideal t I

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc_set : @galois_connection
  (set A) (set (projective_spectrum 𝒜))ᵒᵈ _ _
  (λ s, zero_locus 𝒜 s) (λ t, vanishing_ideal t) :=
have ideal_gc : galois_connection (ideal.span) coe := (submodule.gi A _).gc,
by simpa [zero_locus_span, function.comp] using galois_connection.compose ideal_gc (gc_ideal 𝒜)

lemma gc_homogeneous_ideal : @galois_connection
  (homogeneous_ideal 𝒜) (set (projective_spectrum 𝒜))ᵒᵈ _ _
  (λ I, zero_locus 𝒜 I) (λ t, (vanishing_ideal t)) :=
λ I t, by simpa [show I.to_ideal ≤ (vanishing_ideal t).to_ideal ↔ I ≤ (vanishing_ideal t),
  from iff.rfl] using subset_zero_locus_iff_le_vanishing_ideal t I.to_ideal

lemma subset_zero_locus_iff_subset_vanishing_ideal (t : set (projective_spectrum 𝒜))
  (s : set A) :
  t ⊆ zero_locus 𝒜 s ↔ s ⊆ vanishing_ideal t :=
(gc_set _) s t

lemma subset_vanishing_ideal_zero_locus (s : set A) :
  s ⊆ vanishing_ideal (zero_locus 𝒜 s) :=
(gc_set _).le_u_l s

lemma ideal_le_vanishing_ideal_zero_locus (I : ideal A) :
  I ≤ (vanishing_ideal (zero_locus 𝒜 I)).to_ideal :=
(gc_ideal _).le_u_l I

lemma homogeneous_ideal_le_vanishing_ideal_zero_locus (I : homogeneous_ideal 𝒜) :
  I ≤ vanishing_ideal (zero_locus 𝒜 I) :=
(gc_homogeneous_ideal _).le_u_l I

lemma subset_zero_locus_vanishing_ideal (t : set (projective_spectrum 𝒜)) :
  t ⊆ zero_locus 𝒜 (vanishing_ideal t) :=
(gc_ideal _).l_u_le t

lemma zero_locus_anti_mono {s t : set A} (h : s ⊆ t) : zero_locus 𝒜 t ⊆ zero_locus 𝒜 s :=
(gc_set _).monotone_l h

lemma zero_locus_anti_mono_ideal {s t : ideal A} (h : s ≤ t) :
  zero_locus 𝒜 (t : set A) ⊆ zero_locus 𝒜 (s : set A) :=
(gc_ideal _).monotone_l h

lemma zero_locus_anti_mono_homogeneous_ideal {s t : homogeneous_ideal 𝒜} (h : s ≤ t) :
  zero_locus 𝒜 (t : set A) ⊆ zero_locus 𝒜 (s : set A) :=
(gc_homogeneous_ideal _).monotone_l h

lemma vanishing_ideal_anti_mono {s t : set (projective_spectrum 𝒜)} (h : s ⊆ t) :
  vanishing_ideal t ≤ vanishing_ideal s :=
(gc_ideal _).monotone_u h

lemma zero_locus_bot :
  zero_locus 𝒜 ((⊥ : ideal A) : set A) = set.univ :=
(gc_ideal 𝒜).l_bot

@[simp] lemma zero_locus_singleton_zero :
  zero_locus 𝒜 ({0} : set A) = set.univ :=
zero_locus_bot _

@[simp] lemma zero_locus_empty :
  zero_locus 𝒜 (∅ : set A) = set.univ :=
(gc_set 𝒜).l_bot

@[simp] lemma vanishing_ideal_univ :
  vanishing_ideal (∅ : set (projective_spectrum 𝒜)) = ⊤ :=
by simpa using (gc_ideal _).u_top

lemma zero_locus_empty_of_one_mem {s : set A} (h : (1:A) ∈ s) :
  zero_locus 𝒜 s = ∅ :=
set.eq_empty_iff_forall_not_mem.mpr $ λ x hx,
  (infer_instance : x.as_homogeneous_ideal.to_ideal.is_prime).ne_top $
  x.as_homogeneous_ideal.to_ideal.eq_top_iff_one.mpr $ hx h

@[simp] lemma zero_locus_singleton_one :
  zero_locus 𝒜 ({1} : set A) = ∅ :=
zero_locus_empty_of_one_mem 𝒜 (set.mem_singleton (1 : A))

@[simp] lemma zero_locus_univ :
  zero_locus 𝒜 (set.univ : set A) = ∅ :=
zero_locus_empty_of_one_mem _ (set.mem_univ 1)

lemma zero_locus_sup_ideal (I J : ideal A) :
  zero_locus 𝒜 ((I ⊔ J : ideal A) : set A) = zero_locus _ I ∩ zero_locus _ J :=
(gc_ideal 𝒜).l_sup

lemma zero_locus_sup_homogeneous_ideal (I J : homogeneous_ideal 𝒜) :
  zero_locus 𝒜 ((I ⊔ J : homogeneous_ideal 𝒜) : set A) = zero_locus _ I ∩ zero_locus _ J :=
(gc_homogeneous_ideal 𝒜).l_sup

lemma zero_locus_union (s s' : set A) :
  zero_locus 𝒜 (s ∪ s') = zero_locus _ s ∩ zero_locus _ s' :=
(gc_set 𝒜).l_sup

lemma vanishing_ideal_union (t t' : set (projective_spectrum 𝒜)) :
  vanishing_ideal (t ∪ t') = vanishing_ideal t ⊓ vanishing_ideal t' :=
by ext1; convert (gc_ideal 𝒜).u_inf

lemma zero_locus_supr_ideal {γ : Sort*} (I : γ → ideal A) :
  zero_locus _ ((⨆ i, I i : ideal A) : set A) = (⋂ i, zero_locus 𝒜 (I i)) :=
(gc_ideal 𝒜).l_supr

lemma zero_locus_supr_homogeneous_ideal {γ : Sort*} (I : γ → homogeneous_ideal 𝒜) :
  zero_locus _ ((⨆ i, I i : homogeneous_ideal 𝒜) : set A) = (⋂ i, zero_locus 𝒜 (I i)) :=
(gc_homogeneous_ideal 𝒜).l_supr

lemma zero_locus_Union {γ : Sort*} (s : γ → set A) :
  zero_locus 𝒜 (⋃ i, s i) = (⋂ i, zero_locus 𝒜 (s i)) :=
(gc_set 𝒜).l_supr

lemma zero_locus_bUnion (s : set (set A)) :
  zero_locus 𝒜 (⋃ s' ∈ s, s' : set A) = ⋂ s' ∈ s, zero_locus 𝒜 s' :=
by simp only [zero_locus_Union]

lemma vanishing_ideal_Union {γ : Sort*} (t : γ → set (projective_spectrum 𝒜)) :
  vanishing_ideal (⋃ i, t i) = (⨅ i, vanishing_ideal (t i)) :=
homogeneous_ideal.to_ideal_injective $
by convert (gc_ideal 𝒜).u_infi; exact homogeneous_ideal.to_ideal_infi _

lemma zero_locus_inf (I J : ideal A) :
  zero_locus 𝒜 ((I ⊓ J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
set.ext $ λ x, x.is_prime.inf_le

lemma union_zero_locus (s s' : set A) :
  zero_locus 𝒜 s ∪ zero_locus 𝒜 s' = zero_locus 𝒜 ((ideal.span s) ⊓ (ideal.span s'): ideal A) :=
by { rw zero_locus_inf, simp }

lemma zero_locus_mul_ideal (I J : ideal A) :
  zero_locus 𝒜 ((I * J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
set.ext $ λ x, x.is_prime.mul_le

lemma zero_locus_mul_homogeneous_ideal (I J : homogeneous_ideal 𝒜) :
  zero_locus 𝒜 ((I * J : homogeneous_ideal 𝒜) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
set.ext $ λ x, x.is_prime.mul_le

lemma zero_locus_singleton_mul (f g : A) :
  zero_locus 𝒜 ({f * g} : set A) = zero_locus 𝒜 {f} ∪ zero_locus 𝒜 {g} :=
set.ext $ λ x, by simpa using x.is_prime.mul_mem_iff_mem_or_mem

@[simp] lemma zero_locus_singleton_pow (f : A) (n : ℕ) (hn : 0 < n) :
  zero_locus 𝒜 ({f ^ n} : set A) = zero_locus 𝒜 {f} :=
set.ext $ λ x, by simpa using x.is_prime.pow_mem_iff_mem n hn

lemma sup_vanishing_ideal_le (t t' : set (projective_spectrum 𝒜)) :
  vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') :=
begin
  intros r,
  rw [← homogeneous_ideal.mem_iff, homogeneous_ideal.to_ideal_sup, mem_vanishing_ideal,
    submodule.mem_sup],
  rintro ⟨f, hf, g, hg, rfl⟩ x ⟨hxt, hxt'⟩,
  erw mem_vanishing_ideal at hf hg,
  apply submodule.add_mem; solve_by_elim
end

lemma mem_compl_zero_locus_iff_not_mem {f : A} {I : projective_spectrum 𝒜} :
  I ∈ (zero_locus 𝒜 {f} : set (projective_spectrum 𝒜))ᶜ ↔ f ∉ I.as_homogeneous_ideal :=
by rw [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]; refl

/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets
of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/
instance zariski_topology : topological_space (projective_spectrum 𝒜) :=
topological_space.of_closed (set.range (projective_spectrum.zero_locus 𝒜))
  (⟨set.univ, by simp⟩)
  begin
    intros Zs h,
    rw set.sInter_eq_Inter,
    let f : Zs → set _ := λ i, classical.some (h i.2),
    have hf : ∀ i : Zs, ↑i = zero_locus 𝒜 (f i) := λ i, (classical.some_spec (h i.2)).symm,
    simp only [hf],
    exact ⟨_, zero_locus_Union 𝒜 _⟩
  end
  (by { rintros _ ⟨s, rfl⟩ _ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus 𝒜 s t).symm⟩ })

/-- The underlying topology of `Proj` is the projective spectrum of graded ring `A`. -/
def Top : Top := Top.of (projective_spectrum 𝒜)

lemma is_open_iff (U : set (projective_spectrum 𝒜)) :
  is_open U ↔ ∃ s, Uᶜ = zero_locus 𝒜 s :=
by simp only [@eq_comm _ Uᶜ]; refl

lemma is_closed_iff_zero_locus (Z : set (projective_spectrum 𝒜)) :
  is_closed Z ↔ ∃ s, Z = zero_locus 𝒜 s :=
by rw [← is_open_compl_iff, is_open_iff, compl_compl]

lemma is_closed_zero_locus (s : set A) :
  is_closed (zero_locus 𝒜 s) :=
by { rw [is_closed_iff_zero_locus], exact ⟨s, rfl⟩ }

lemma zero_locus_vanishing_ideal_eq_closure (t : set (projective_spectrum 𝒜)) :
  zero_locus 𝒜 (vanishing_ideal t : set A) = closure t :=
begin
  apply set.subset.antisymm,
  { rintro x hx t' ⟨ht', ht⟩,
    obtain ⟨fs, rfl⟩ : ∃ s, t' = zero_locus 𝒜 s,
    by rwa [is_closed_iff_zero_locus] at ht',
    rw [subset_zero_locus_iff_subset_vanishing_ideal] at ht,
    exact set.subset.trans ht hx },
  { rw (is_closed_zero_locus _ _).closure_subset_iff,
    exact subset_zero_locus_vanishing_ideal 𝒜 t }
end

lemma vanishing_ideal_closure (t : set (projective_spectrum 𝒜)) :
  vanishing_ideal (closure t) = vanishing_ideal t :=
begin
  have := (gc_ideal 𝒜).u_l_u_eq_u t,
  dsimp only at this,
  ext1,
  erw zero_locus_vanishing_ideal_eq_closure 𝒜 t at this,
  exact this,
end

section basic_open

/-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/
def basic_open (r : A) : topological_space.opens (projective_spectrum 𝒜) :=
{ carrier := { x | r ∉ x.as_homogeneous_ideal },
  is_open' := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ }

@[simp] lemma mem_basic_open (f : A) (x : projective_spectrum 𝒜) :
  x ∈ basic_open 𝒜 f ↔ f ∉ x.as_homogeneous_ideal := iff.rfl

lemma mem_coe_basic_open (f : A) (x : projective_spectrum 𝒜) :
  x ∈ (↑(basic_open 𝒜 f): set (projective_spectrum 𝒜)) ↔ f ∉ x.as_homogeneous_ideal := iff.rfl

lemma is_open_basic_open {a : A} : is_open ((basic_open 𝒜 a) :
  set (projective_spectrum 𝒜)) :=
(basic_open 𝒜 a).is_open

@[simp] lemma basic_open_eq_zero_locus_compl (r : A) :
  (basic_open 𝒜 r : set (projective_spectrum 𝒜)) = (zero_locus 𝒜 {r})ᶜ :=
set.ext $ λ x, by simpa only [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]

@[simp] lemma basic_open_one : basic_open 𝒜 (1 : A) = ⊤ :=
topological_space.opens.ext $ by simp

@[simp]

lemma basic_open_mul (f g : A) : basic_open 𝒜 (f * g) = basic_open 𝒜 f ⊓ basic_open 𝒜 g :=
topological_space.opens.ext $ by {simp [zero_locus_singleton_mul]}

lemma basic_open_mul_le_left (f g : A) : basic_open 𝒜 (f * g) ≤ basic_open 𝒜 f :=
by { rw basic_open_mul 𝒜 f g, exact inf_le_left }

lemma basic_open_mul_le_right (f g : A) : basic_open 𝒜 (f * g) ≤ basic_open 𝒜 g :=
by { rw basic_open_mul 𝒜 f g, exact inf_le_right }

@[simp] lemma basic_open_pow (f : A) (n : ℕ) (hn : 0 < n) :
  basic_open 𝒜 (f ^ n) = basic_open 𝒜 f :=
topological_space.opens.ext $ by simpa using zero_locus_singleton_pow 𝒜 f n hn

lemma basic_open_eq_union_of_projection (f : A) :
  basic_open 𝒜 f = ⨆ (i : ℕ), basic_open 𝒜 (graded_algebra.proj 𝒜 i f) :=
topological_space.opens.ext $ set.ext $ λ z, begin
  erw [mem_coe_basic_open, topological_space.opens.mem_Sup],
  split; intros hz,
  { rcases show ∃ i, graded_algebra.proj 𝒜 i f ∉ z.as_homogeneous_ideal, begin
      contrapose! hz with H,
      classical,
      rw ←direct_sum.sum_support_decompose 𝒜 f,
      apply ideal.sum_mem _ (λ i hi, H i)
    end with ⟨i, hi⟩,
    exact ⟨basic_open 𝒜 (graded_algebra.proj 𝒜 i f), ⟨i, rfl⟩, by rwa mem_basic_open⟩ },
  { obtain ⟨_, ⟨i, rfl⟩, hz⟩ := hz,
    exact λ rid, hz (z.1.2 i rid) },
end

lemma is_topological_basis_basic_opens : topological_space.is_topological_basis
  (set.range (λ (r : A), (basic_open 𝒜 r : set (projective_spectrum 𝒜)))) :=
begin
  apply topological_space.is_topological_basis_of_open_of_nhds,
  { rintros _ ⟨r, rfl⟩,
    exact is_open_basic_open 𝒜 },
  { rintros p U hp ⟨s, hs⟩,
    rw [← compl_compl U, set.mem_compl_iff, ← hs, mem_zero_locus, set.not_subset] at hp,
    obtain ⟨f, hfs, hfp⟩ := hp,
    refine ⟨basic_open 𝒜 f, ⟨f, rfl⟩, hfp, _⟩,
    rw [← set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl],
    exact zero_locus_anti_mono 𝒜 (set.singleton_subset_iff.mpr hfs) }
end

end basic_open

section order

/-!
## The specialization order

We endow `projective_spectrum 𝒜` with a partial order,
where `x ≤ y` if and only if `y ∈ closure {x}`.
-/

instance : partial_order (projective_spectrum 𝒜) :=
partial_order.lift as_homogeneous_ideal $ λ ⟨_, _, _⟩ ⟨_, _, _⟩, mk.inj_eq.mpr

@[simp] lemma as_ideal_le_as_ideal (x y : projective_spectrum 𝒜) :
  x.as_homogeneous_ideal ≤ y.as_homogeneous_ideal ↔ x ≤ y :=
iff.rfl

@[simp] lemma as_ideal_lt_as_ideal (x y : projective_spectrum 𝒜) :
  x.as_homogeneous_ideal < y.as_homogeneous_ideal ↔ x < y :=
iff.rfl

lemma le_iff_mem_closure (x y : projective_spectrum 𝒜) :
  x ≤ y ↔ y ∈ closure ({x} : set (projective_spectrum 𝒜)) :=
begin
  rw [← as_ideal_le_as_ideal, ← zero_locus_vanishing_ideal_eq_closure,
    mem_zero_locus, vanishing_ideal_singleton],
  simp only [coe_subset_coe, subtype.coe_le_coe, coe_coe],
end

end order

end projective_spectrum


import Smt

theorem zero_sub' : ∀ x, 0 - x = 0 := by
  intro x
  induction x with
  | zero => smt; rfl
  | succ x ih => smt [ih]; simp [ih, Nat.sub_succ]


import data.real.basic
import data.real.sqrt
import tactic

def seq_limit (s : ℕ → ℝ) (a : ℝ) : Prop :=
∀ ε : ℝ, ε > 0 → ∃ n₀ : ℕ, ∀ n : ℕ, n ≥ n₀ → |s n - a| ≤ ε

-- Arithmetic of limits – the sum law:
-- If [`u` approaches `a`] and [`v` approaches `b`] then [`u + v` approaches `a + b`].
example (u v : ℕ → ℝ) (a b : ℝ) (hu : seq_limit u a) (hv : seq_limit v b) :
  seq_limit (u + v) (a + b) :=
begin
  intros ε ep_pos,
  cases hu (ε / 2) (half_pos ep_pos) with Nᵤ ha,
  cases hv (ε / 2) (half_pos ep_pos) with Nᵥ hb,
  use max Nᵤ Nᵥ,
  intros n n_large,
  change max Nᵤ Nᵥ ≤ n at n_large,
  rw max_le_iff at n_large,
  specialize ha n n_large.left,
  specialize hb n n_large.right,

  change |(u n + v n) - (a + b)| ≤ ε,
  rw abs_le at *,
  split;
  linarith,
end

-- Arithmetic of limits – the product law:
-- If [`u` approaches `a`] and [`v` approaches `b`] then [`u * v` approaches `a * b`].
example (u v : ℕ → ℝ) (a b : ℝ) (hu : seq_limit u a) (hv : seq_limit v b) :
  seq_limit (u * v) (a * b) :=
begin
  intros ε ep_pos,

  have ep_third_pos : ε / 3 > 0,
  {
    linarith,
  },
  have ep_third_nneg : ε / 3 ≥ 0,
  {
    exact le_of_lt ep_third_pos,
  },
  have sqrt_ep_third_pos : 0 < real.sqrt (ε / 3),
  {
    rw real.sqrt_pos,
    exact ep_third_pos,
  },
  have ep_u_pos : min (ε / (3 * (|b| + 1))) (real.sqrt (ε / 3)) > 0,
  {
    apply lt_min,
    {
      have denom_pos : 0 < (3 * (|b| + 1)),
      {
        have : |b| ≥ 0, exact abs_nonneg b,
        have : |b| + 1 > 0, linarith,
        linarith,
      },
      exact div_pos ep_pos denom_pos,
    },
    {
      exact sqrt_ep_third_pos,
    },
  },
  have ep_v_pos : min (ε / (3 * (|a| + 1))) (real.sqrt (ε / 3)) > 0,
  {
    apply lt_min,
    {
      have denom_pos : 0 < (3 * (|a| + 1)),
      {
        have : |a| ≥ 0, exact abs_nonneg a,
        have : |a| + 1 > 0, linarith,
        linarith,
      },
      exact div_pos ep_pos denom_pos,
    },
    {
      exact sqrt_ep_third_pos,
    },
  },
  cases hu (min (ε / (3 * (|b| + 1))) (real.sqrt (ε / 3))) ep_u_pos with Nᵤ ha,
  cases hv (min (ε / (3 * (|a| + 1))) (real.sqrt (ε / 3))) ep_v_pos with Nᵥ hb,
  use max Nᵤ Nᵥ,
  intros n n_large,
  specialize ha n (le_of_max_le_left  n_large),
  specialize hb n (le_of_max_le_right n_large),
  have trick :
    (u n * v n) - a * b = (u n - a) * b + (v n - b) * a + (u n - a) * (v n - b),
  {
    ring,
  },
  change |(u n * v n) - a * b| ≤ ε,
  rw trick,

  have fst_summand : |(u n - a) * b| ≤ ε / 3,
  {
    rw abs_mul,
    have ha' : |u n - a| ≤ (ε / (3 * (|b| + 1))), calc |u n - a|
          ≤ min (ε / (3 * (|b| + 1))) (real.sqrt (ε / 3)) : ha
      ... ≤ (ε / (3 * (|b| + 1))) : min_le_left _ _,
    have foo : |b| ≤ (|b| + 1), linarith,
    have bar : |b| ≥ 0, exact abs_nonneg b,
    have baz : |b| + 1 > 0, linarith,
    have qux : (|b| / (|b| + 1)) ≤ 1,
    {
      rw div_le_one baz,
      exact foo,
    },
    calc |u n - a| * |b|
        ≤ (ε / (3 * (|b| + 1))) * |b| : mul_le_mul_of_nonneg_right ha' (abs_nonneg _)
    ... = ((ε / 3) / (|b| + 1)) * |b| : by rw div_div
    ... = (ε / 3) * (|b| / (|b| + 1)) : mul_comm_div _ _ _
    ... ≤ (ε / 3) * 1 : mul_le_mul_of_nonneg_left qux ep_third_nneg
    ... = ε / 3 : mul_one _,
  },
  have snd_summand : |(v n - b) * a| ≤ ε / 3,
  {
    rw abs_mul,
    have hb' : |v n - b| ≤ (ε / (3 * (|a| + 1))), calc |v n - b|
          ≤ min (ε / (3 * (|a| + 1))) (real.sqrt (ε / 3)) : hb
      ... ≤ (ε / (3 * (|a| + 1))) : min_le_left _ _,
    have foo : |a| ≤ (|a| + 1), linarith,
    have bar : |a| ≥ 0, exact abs_nonneg a,
    have baz : |a| + 1 > 0, linarith,
    have qux : (|a| / (|a| + 1)) ≤ 1,
    {
      rw div_le_one baz,
      exact foo,
    },
    calc |v n - b| * |a|
        ≤ (ε / (3 * (|a| + 1))) * |a| : mul_le_mul_of_nonneg_right hb' (abs_nonneg _)
    ... = ((ε / 3) / (|a| + 1)) * |a| : by rw div_div
    ... = (ε / 3) * (|a| / (|a| + 1)) : mul_comm_div _ _ _
    ... ≤ (ε / 3) * 1 : mul_le_mul_of_nonneg_left qux ep_third_nneg
    ... = ε / 3 : mul_one _,
  },
  have last_summand : |(u n - a) * (v n - b)| ≤ ε / 3,
  {
    rw abs_mul,
    have ha'' : |u n - a| ≤ (real.sqrt (ε / 3)), calc |u n - a|
          ≤ min (ε / (3 * (|b| + 1))) (real.sqrt (ε / 3)) : ha
      ... ≤ (real.sqrt (ε / 3)) : min_le_right _ _,
    have hb'' : |v n - b| ≤ (real.sqrt (ε / 3)), calc |v n - b|
          ≤ min (ε / (3 * (|a| + 1))) (real.sqrt (ε / 3)) : hb
      ... ≤ (real.sqrt (ε / 3)) : min_le_right _ _,
    calc |u n - a| * |v n - b|
        ≤ real.sqrt (ε / 3) * |v n - b|         : mul_le_mul_of_nonneg_right ha'' (abs_nonneg _)
    ... ≤ real.sqrt (ε / 3) * real.sqrt (ε / 3) : mul_le_mul_of_nonneg_left hb'' (real.sqrt_nonneg _)
    ... = ε / 3 : real.mul_self_sqrt ep_third_nneg,
  },
  calc | (u n - a) * b  +  (v n - b) * a  +  (u n - a) * (v n - b)|
      ≤ |(u n - a) * b  +  (v n - b) * a| + |(u n - a) * (v n - b)| : abs_add _ _
  ... ≤ |(u n - a) * b| + |(v n - b) * a| + |(u n - a) * (v n - b)| : add_le_add (abs_add _ _) (le_of_eq rfl)
  ... ≤ ε / 3 + ε / 3 + ε / 3 : add_le_add (add_le_add fst_summand snd_summand) last_summand
  ... = ε : by ring,
end

def fun_limit (f : ℝ → ℝ) : ℝ → ℝ → Prop :=
  λ x, λ ℓ, ∀ ε : ℝ, ∃ δ : ℝ, (ε > 0) →
    ((δ > 0) ∧ (∀ a : ℝ, ((a ≠ x) ∧ (abs (x - a) < δ)) → (abs (ℓ - f a) < ε)))

def is_continuous_at (f : ℝ → ℝ) : ℝ → Prop :=
  λ x, fun_limit f x (f x)

def is_continuous_function (f : ℝ → ℝ) : Prop :=
  ∀ x, is_continuous_at f x

def has_derivative_exactly (f : ℝ → ℝ) : ℝ → ℝ → Prop :=
  λ x, λ s, fun_limit (λ h : ℝ, (f (x + h) - (f x)) / h) 0 s

example : fun_limit (λ x : ℝ, 3*x) 10 30 :=
begin
  unfold fun_limit,
  intro ε,
  use (ε / 3),
  intro epp,
  split,
  {
    linarith,
  },
  intro a,
  intro assumptions,
  cases assumptions with un important,
  have absol₃ : abs (3 : ℝ) = (3 : ℝ),
  {
    simp,
    linarith,
  },
  calc abs (30 - 3 * a) = abs (3 * (10 - a))     : by ring_nf
  ...                   = (abs 3) * abs (10 - a) : by rw abs_mul
  ...                   = 3 * abs (10 - a)       : by rw absol₃
  ...                   < 3 * ε / 3              : by linarith
  ...                   = ε                      : by ring
end

example : has_derivative_exactly (λ x, x*x) 100 200 :=
begin
  unfold has_derivative_exactly,
  unfold fun_limit,
  intro ε,
  use ε,
  intro epp,
  split,
  {
    exact epp,
  },
  intro h,
  intro assum,
  cases assum with h_not_zero h_near_zero,
  have absm_h_small : abs (- h) < ε,
  {
    rw zero_sub at h_near_zero,
    exact h_near_zero,
  },
  have crap : h = 0 → 200 + h = 0,
  {
    contrapose!,
    intro foo,
    exact h_not_zero,
  },
  calc abs (200 - ((100 + h) * (100 + h) - 100 * 100) / h)
       = abs (200 - (100 * 100 + 200 * h + h * h - 100 * 100) / h) : by ring_nf
  ...  = abs (200 - (200 * h + h * h) / h)                         : by ring_nf
  ...  = abs (200 - (h * (200 + h)) / h)                           : by ring_nf
  ...  = abs (200 - (200 + h))                                     : by rw mul_div_cancel_left_of_imp crap
  ...  = abs (- h)                                                 : by ring_nf
  ...  < ε                                                         : absm_h_small,
end


import mynat.add

namespace mynat

/-
add_zero (a : mynat) := a + 0 = a
add_succ (a b : mynat) := a + succ(b) = succ(a + b)
-/

lemma add_succ_zero (a : mynat) : a + succ(0) = succ(a) :=
begin [nat_num_game]
  rw add_succ,
  rw add_zero,
  refl,
end

end mynat


namespace prop_15

variables A B C : Prop

open classical

theorem prop_15 : ((A ∧ B) → C) → ((A → C) ∨ (B → C)) :=
assume h1 : (A ∧ B) → C,
show (A → C) ∨ (B → C), from or.elim (classical.em B)
    (assume h2: B,
     show (A → C) ∨ (B → C), from or.inl
        (assume h3: A,
         h1 (and.intro h3 h2)))
    (assume h4: ¬ B,
     show (A → C) ∨ (B → C), from or.inr
        (assume h5: B,
         have h6: false, from h4 h5,
         show C, from (classical.by_contradiction
            (assume hnc: ¬ C,
             h6))))

-- end namespace
end prop_15


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

! This file was ported from Lean 3 source module topology.algebra.order.upper_lower
! leanprover-community/mathlib commit 992efbda6f85a5c9074375d3c7cb9764c64d8f72
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.UpperLower
import Mathlib.Topology.Algebra.Group.Basic

/-!
# Topological facts about upper/lower/order-connected sets

The topological closure and interior of an upper/lower/order-connected set is an
upper/lower/order-connected set (with the notable exception of the closure of an order-connected
set).

## Implementation notes

The same lemmas are true in the additive/multiplicative worlds. To avoid code duplication, we
provide `HasUpperLowerClosure`, an ad hoc axiomatisation of the properties we need.
-/

open Function Set

open Pointwise

/-- Ad hoc class stating that the closure of an upper set is an upper set. This is used to state
lemmas that do not mention algebraic operations for both the additive and multiplicative versions
simultaneously. If you find a satisfying replacement for this typeclass, please remove it! -/
class HasUpperLowerClosure (α : Type _) [TopologicalSpace α] [Preorder α] : Prop where
  isUpperSet_closure : ∀ s : Set α, IsUpperSet s → IsUpperSet (closure s)
  isLowerSet_closure : ∀ s : Set α, IsLowerSet s → IsLowerSet (closure s)
  isOpen_upperClosure : ∀ s : Set α, IsOpen s → IsOpen (upperClosure s : Set α)
  isOpen_lowerClosure : ∀ s : Set α, IsOpen s → IsOpen (lowerClosure s : Set α)
#align has_upper_lower_closure HasUpperLowerClosure

variable {α : Type _} [TopologicalSpace α]

-- See note [lower instance priority]
@[to_additive]
instance (priority := 100) OrderedCommGroup.to_hasUpperLowerClosure [OrderedCommGroup α]
    [ContinuousConstSMul α α] : HasUpperLowerClosure α
    where
  isUpperSet_closure s h x y hxy hx :=
    closure_mono (h.smul_subset <| one_le_div'.2 hxy) <|
      by
      rw [closure_smul]
      exact ⟨x, hx, div_mul_cancel' _ _⟩
  isLowerSet_closure s h x y hxy hx :=
    closure_mono (h.smul_subset <| div_le_one'.2 hxy) <|
      by
      rw [closure_smul]
      exact ⟨x, hx, div_mul_cancel' _ _⟩
  isOpen_upperClosure s hs := by
    rw [← mul_one s, ← mul_upperClosure]
    exact hs.mul_right
  isOpen_lowerClosure s hs := by
    rw [← mul_one s, ← mul_lowerClosure]
    exact hs.mul_right
#align ordered_comm_group.to_has_upper_lower_closure OrderedCommGroup.to_hasUpperLowerClosure
#align ordered_add_comm_group.to_has_upper_lower_closure OrderedAddCommGroup.to_hasUpperLowerClosure

variable [Preorder α] [HasUpperLowerClosure α] {s : Set α}

protected theorem IsUpperSet.closure : IsUpperSet s → IsUpperSet (closure s) :=
  HasUpperLowerClosure.isUpperSet_closure _
#align is_upper_set.closure IsUpperSet.closure

protected theorem IsLowerSet.closure : IsLowerSet s → IsLowerSet (closure s) :=
  HasUpperLowerClosure.isLowerSet_closure _
#align is_lower_set.closure IsLowerSet.closure

protected theorem IsOpen.upperClosure : IsOpen s → IsOpen (upperClosure s : Set α) :=
  HasUpperLowerClosure.isOpen_upperClosure _
#align is_open.upper_closure IsOpen.upperClosure

protected theorem IsOpen.lowerClosure : IsOpen s → IsOpen (lowerClosure s : Set α) :=
  HasUpperLowerClosure.isOpen_lowerClosure _
#align is_open.lower_closure IsOpen.lowerClosure

instance : HasUpperLowerClosure αᵒᵈ
    where
  isUpperSet_closure := @IsLowerSet.closure α _ _ _
  isLowerSet_closure := @IsUpperSet.closure α _ _ _
  isOpen_upperClosure := @IsOpen.lowerClosure α _ _ _
  isOpen_lowerClosure := @IsOpen.upperClosure α _ _ _

/-
Note: `s.OrdConnected` does not imply `(closure s).OrdConnected`, as we can see by taking
`s := Ioo 0 1 × Ioo 1 2 ∪ Ioo 2 3 × Ioo 0 1` because then
`closure s = Icc 0 1 × Icc 1 2 ∪ Icc 2 3 × Icc 0 1` is not order-connected as
`(1, 1) ∈ closure s`, `(2, 1) ∈ closure s` but `Icc (1, 1) (2, 1) ⊈ closure s`.

`s` looks like
```
xxooooo
xxooooo
oooooxx
oooooxx
```
-/
protected theorem IsUpperSet.interior (h : IsUpperSet s) : IsUpperSet (interior s) := by
  rw [← isLowerSet_compl, ← closure_compl]
  exact h.compl.closure
#align is_upper_set.interior IsUpperSet.interior

protected theorem IsLowerSet.interior (h : IsLowerSet s) : IsLowerSet (interior s) :=
  h.ofDual.interior
#align is_lower_set.interior IsLowerSet.interior

protected theorem Set.OrdConnected.interior (h : s.OrdConnected) : (interior s).OrdConnected := by
  rw [← h.upperClosure_inter_lowerClosure, interior_inter]
  exact
    (upperClosure s).upper.interior.ordConnected.inter (lowerClosure s).lower.interior.ordConnected
#align set.ord_connected.interior Set.OrdConnected.interior


import data.real.basic

open function

-- BEGIN
example {f : ℝ → ℝ} (h : surjective f) : ∃ x, (f x)^2 = 4 :=
begin
  cases h 2 with x hx,
  use x,
  sorry,
end
-- END


import group_theory.coset ring_theory.matrix ring_theory.determinant ring_theory.ideals  algebra.gcd_domain algebra.euclidean_domain data.int.modeq group_theory.quotient_group data.equiv.algebra group_theory.subgroup
import tactic.ring tactic.fin_cases tactic.tidy
open function quotient_group group is_group_hom set classical
noncomputable theory

structure group_equiv (G H : Type*) [group G] [group H] extends G ≃ H :=
	(hom: is_group_hom to_fun)
	(inv_hom: is_group_hom inv_fun)
infix ` ≅ `:50 := group_equiv

namespace group_equiv
--I'd like not to repeat the Type*, but then there's an error with shadowing local universes.
variables{G:Type*}{H:Type*}{K:Type*}[group G][group H][group K]  {X:Type*}{Y:Type*}{Z:Type*}

instance: has_coe(G≅H)(G≃H) := ⟨λx,{..x}⟩

def via_biject_hom(f: G→H)(b: bijective f)(h: is_group_hom f): G ≅ H := {
	hom:=h,
	inv_hom:=⟨begin
		let E:= equiv.of_bijective b,
		let f:= E.to_fun,
		let g:= E.inv_fun,
		intros x y,
		change g(x*y) = g x * g y,
		have gf: ∀ a, g(f a) = a := E.left_inv,
		have fg: ∀ a, f(g a) = a := E.right_inv,
		rw[←gf(g x * g y)],
		apply congr_arg,
		have: f(g x * g y) = f(g x) * f(g y) := by apply h.mul,
		rw[this,fg,fg],
	end⟩,
	..equiv.of_bijective b
}

lemma bijective_comp{f:Y→Z}{g:X→Y}(bijf: bijective f)(bijg: bijective g): bijective(f∘g) :=begin
	constructor,
		{tidy},
	intro a,
	rcases bijf.right a with ⟨b, fb_a⟩,
	rcases bijg.right b with ⟨c, gc_b⟩,
	exact ⟨c,by simp;cc⟩,
end
protected def bijective(f: G ≅ H): bijective f := equiv.bijective f
instance(f: G≅H): is_group_hom f := f.hom

protected def refl: G ≅ G := via_biject_hom id (by simp[bijective,injective,surjective]) ⟨by simp⟩
protected def symm(f: G ≅ H): H ≅ G := {
	to_fun:= f.inv_fun,
	inv_fun:= f.to_fun,
	left_inv:= f.right_inv,
	right_inv:= f.left_inv,
	hom:= f.inv_hom,
	inv_hom:= f.hom,
}
protected def trans(gh: G ≅ H)(hk: H ≅ K): G ≅ K := via_biject_hom(hk ∘ gh) (bijective_comp hk.bijective gh.bijective) (by apply_instance) --infer_instance doesn't check

@[extensionality] lemma range_ext(f: X→Y)(x y ix iy)(x'y: x=y): (⟨x,ix⟩: range f) = ⟨y,iy⟩ := by simp[x'y]

--The first isomorphism theorem for groups. This one relates quotient to range, whereas the version below it avoids range assuming surjectivity.
def quotient_ker_isom_range(f: G→H)[is_group_hom f]: quotient(ker f) ≅ range f :=
	@via_biject_hom _ (range f) _ _
		(λ x, ⟨lift (ker f) f
  			(by simp [mem_ker]) x, by exact quotient.induction_on' x (λ x, ⟨x, rfl⟩)⟩)
  		⟨λ a b h, injective_ker_lift _ (subtype.mk.inj h),
  			λ ⟨x, y, hy⟩, ⟨quotient_group.mk y, subtype.eq hy⟩⟩
		⟨λx y, begin
			induction x,
			induction y,
			change (⟨quotient_group.lift (ker f) f _ (quotient_group.mk x * quotient_group.mk y), _⟩ : range f) = ⟨f x * f y, _⟩,
      ext,
		rw ←is_group_hom.mul f,
		repeat{refl},
		end⟩

def quotient_ker_isom_of_surjective(f: G→H)[is_group_hom f](s: surjective f): quotient(ker f) ≅ H :=
	(quotient_ker_isom_range f).trans(via_biject_hom subtype.val(begin
		constructor,
			{tidy},
		intro x,
		rcases s x with ⟨y, fy_x⟩,
		exact⟨⟨f y, by tidy⟩, by simpa⟩,
	end) (by tidy))
def isomorphism_theorem_1 := @quotient_ker_isom_range

--–1. attempt: use subsets (⟹ dead end)

def as_subset{A B: set X}(AsubB: A ⊆ B): set B := λb, A b
--Maximum class instance resolution depth gets continuously exceeded with this coercion...
instance coe_subset{B: set X}: has_coe(set X)(set B) := ⟨λA b, A b⟩
--...hence I package set under another name. This is for prototyping. Lifting all the definitions from set is inpractical, and a fixed type class inference should handle this IMO.
structure sub(T: Type*) := (base: set T)
namespace sub

instance: has_coe_to_sort(sub X) := {S:=Sort*, coe:=λs, (set.has_coe_to_sort.coe: set X → Sort _) s.base}
instance{B: sub X}: has_coe(sub X)(sub B) := ⟨λA, ⟨λb, A.base b⟩⟩

end sub

variables{M N S : sub G}[is_subgroup M.base][is_subgroup S.base][normal_subgroup N.base]

instance: is_subgroup((S: sub M).base) := {
	one_mem:= _inst_5.one_mem,
	mul_mem:=begin
		intros,
		have:= _inst_5.mul_mem,
		apply this a_1 a_2,
	end,
	inv_mem:=begin
		intros,
		have:= _inst_5.inv_mem,
		apply this a_1,
	end,
}
instance: normal_subgroup((N: sub M).base) := ⟨begin
	intros,
	change N.base(g*n*g⁻¹),
	have:= _inst_6.normal,
	apply this n _ g,
	apply H,
end⟩

--Result of these definitions: quotient between subgroups becomes defined.
@[reducible]def explicit_quotient(G:Type*)(N: sub G)[group G][normal_subgroup N.base] := quotient N.base
infix `∕`:70 := explicit_quotient
#check M∕N
--But quotients are not subtypes of each others of course.
--example[nM: normal_subgroup M.base](N_M: N.base ⊆ M.base): M∕N ⊆ G∕N

--–2. attempt: use embeddings with inference (⟹ too hard to infer)

--Embedding for sets
class embed(X Y : Type*) := (fn: X → Y)(inj: injective fn)
--To avoid non-termination, transitive closure must be build into another class, as in coe.lean. In general the rule is to take parameters of type embedₜ and produce instances of type embed.
class embedₜ(X Y : Type*) := (fn: X → Y)(inj: injective fn)
namespace embed

instance: has_coe_to_fun(embedₜ X Y) := {
	F:=λ_, X→Y,
	coe:= λi, i.fn
}
instance set{A: set X}: embed A X := {fn:=subtype.val, inj:= by tidy}

instance[i: embed X Y][j: embedₜ Y Z]: embedₜ X Z := {fn:= j.fn ∘ i.fn, inj:=begin
	have:= i.inj,
	have:= j.inj,
	tidy,
end}
--Note: It is very helpful to place the base case after the branch case for the inference engine!
instance base[i: embed X Y]: embedₜ X Y := {..i}

end embed

--Embedding for groups
class embed_group(G H : Type*)[group G][group H] extends embed G H := (hom: is_group_hom fn)
class embed_groupₜ(G H : Type*)[group G][group H] extends embedₜ G H := (hom: is_group_hom fn)
namespace embed_group
variables[i₁: embed_group G H][i: embed_groupₜ G H][j: embed_groupₜ H K]

instance set: embed_group S G := {hom:= by tidy, ..embed.set}

--Compare coe:X→Y and instance[X]:Y. Both are implicit conversions, but the first is for explicit terms whereas the second for implicit. Actually extends-declaration produces the second type of conversion:
example[embed_group G H]: embedₜ G H := infer_instance
--Explicit embeddings are supposed to be from the transitive closure, so coercion for them sufficies. Moreover lack of conversion for single step class can signal an error if ₜ is forgotten from a parameter (with unhelpful message).
instance: has_coe(embed_groupₜ G H)(embedₜ G H) := ⟨λi,{..i}⟩

instance: is_group_hom i := i.hom

--Problem: A definition may require a context with G⥅H and H⥅K, and then use the composed version. Assuming only G↪H in 1 step is generally too restrictive. I see no other way than to use explicit composition in this case.
def trans_comp(i: embed_groupₜ G H)(j: embed_groupₜ H K): embed_groupₜ G K :={
	fn:= j.fn ∘ i.fn,
	inj:=begin
		have:= i.inj,
		have:= j.inj,
		tidy,
	end,
	hom:= @is_group_hom.comp _ _ _ _ _ i.hom _ _ _ j.hom,
}

instance: embed_groupₜ G K := let _:=i₁ in trans_comp{..i₁}j
instance base: embed_groupₜ G H := {..i₁}

@[reducible]def quot_by_embed(H G : Type*)[group G][group H][i: embed_groupₜ G H] := quotient_group.quotient(range i)
infix `./ `:70 := quot_by_embed

def atomic_trans{R: embed_group G H → Sort*}(F: ∀[i₁: embed_group G H], R i₁)[i: embed_groupₜ G H] := @F{..i}

--Because the common assumption pair G ↪ₜ H ↪ₜ K doesn't chain automatically, the notation K./G can't be used.
private def K'G(i: embed_groupₜ G H)(j: embed_groupₜ H K) := @quot_by_embed K G _ _ (trans_comp i j)

def embed_and_quot_mk: H → K'G i j := @quotient_group.mk K _ (range(j∘i)) (by apply_instance) ∘ j

--If G is not normal, H/G is just a set and the lift for homomorphisms can't be used.
def nnlift(f: H → X)(h: ∀ a b, a⁻¹ * b ∈ range i → f a = f b): H./G → X := @quotient.lift _ _ (left_rel(range i)) f h

lemma embed_and_quot_mk_liftable: ∀ a b, a⁻¹ * b ∈ range i → embed_and_quot_mk a = (embed_and_quot_mk b : K'G i j)
:= let j:=j in begin
	intros,
	simp[embed_and_quot_mk],
	apply quotient_group.eq.mpr,
	change (j a)⁻¹ * j b ∈ range _,
	rw[←is_group_hom.inv j, ←is_group_hom.mul j],
	simp[has_mem.mem, set.mem, range],
	rcases a_1 with ⟨x, ix_a'b⟩,
	exact⟨x, by tidy⟩,
end

instance quot: embed(H./G)(K'G i j) := {
	fn:= nnlift embed_and_quot_mk embed_and_quot_mk_liftable,
	inj:= begin
		unfold injective,
		intros,
		induction a₁,
		induction a₂,
		apply quot.sound,
		change a₁⁻¹ * a₂ ∈ _,
		have: embed_and_quot_mk a₁ = embed_and_quot_mk a₂ := a,
		simp[embed_and_quot_mk] at this,
		have j_goal: (j a₁)⁻¹ * j a₂ ∈ range(j∘i) := (@quotient_group.eq K _ (range(j∘i)) _ (j a₁) (j a₂)).mp this,
		rw[←is_group_hom.inv j a₁, ←is_group_hom.mul j] at j_goal,
		rcases j_goal with ⟨x, e⟩,
		exact⟨x, begin apply j.inj, exact e end⟩,
	refl,refl,end,
}

--Next the normality is addied to the embeddings. Note that embed_normal is not an extension of embed_group but instead a property for it. This way it should be applicable to compositions of embeddings more flexibly.
class embed_normal(G H : Type*)[group G][group H][i: embed_groupₜ G H] := {normal: normal_subgroup(range i)}
--More explicit version.
@[reducible]def is_normal(i: embed_groupₜ G H) := @embed_normal G H _ _ i

variables[nj: embed_normal H K][nji: is_normal(trans_comp i j)]

instance[nj: is_normal j]: normal_subgroup(range j) := nj.normal
instance[nj: is_normal j]: group(K./H) := by apply_instance

instance comp_right_normal: is_normal i := {normal:=let _:=nji in ⟨begin
	intros,
	tactic.unfreeze_local_instances,
	rcases nji,
	have:= @normal_subgroup.normal K _ (range(j∘i)) nji (j n) _ (j g),
		rw[←is_group_hom.inv j, ←is_group_hom.mul j, ←is_group_hom.mul j] at this,
		rcases this with ⟨x, e⟩,
		simp at e,
		exact⟨x, begin apply j.inj, exact e end⟩,
	rcases H_1 with ⟨x,e⟩,
	exact⟨x, congr_arg j e⟩,
end⟩}

instance right_normal: normal_subgroup(range i) := (@embed_group.comp_right_normal G H K _ _ _ i j nji).normal

/-instance[i₁: embed_group G H][nji: is_normal(trans_comp (by apply_instance : embed_groupₜ G H) j)]: group(K./G) := begin
	have i: embed_groupₜ G H, apply_instance,
	have: normal_subgroup(range((trans_comp (by apply_instance : embed_groupₜ G H) j : embed_groupₜ G K) : G→K)), apply_instance,
		have:= @embed_group.normal_subgroup _ _ _ _ _ nji,
		rwa(_: j∘i = ((group_equiv.embed_groupₜ : embed_groupₜ _ _).fn : G→K)),
		have: embedₜ.fn K = j.fn ∘ i.fn,
			simp[embedₜ.fn],
end--/

instance right_group: group(@quot_by_embed H G _ _ i) := let _:=K,_:=j,_:=nji in begin
	have:= @embed_group.right_normal G H K _ _ _ i j nji,
	apply_instance,
end

instance group_K'G: group(K'G i j) :=let _:=nji in begin
	tactic.unfreeze_local_instances,
	rcases nji,
	exact @quotient_group.group K _inst_3 (range(j∘i)) nji,
end

instance hom_quot[nji: @embed_normal G K _ _ (trans_comp i j)]: embed_groupₜ(H./G)(K'G i j) := {
	hom:=⟨λa b, begin
		induction a,
		induction b,
		let f: H → H./G := quotient_group.mk,
		have: is_group_hom f, apply_instance,
		change embed.fn (K'G _ _) (f a * f b) = embed_group.embed_and_quot_mk a * embed_group.embed_and_quot_mk b,
		rw ←is_group_hom.mul f,
		change embed_group.embed_and_quot_mk _ = _,
		let f': K → _ := @quotient_group.mk K _ (range(j∘i)) (by apply_instance),
		tactic.unfreeze_local_instances,
		rcases nji,
		have nor: normal_subgroup(range(j∘i)) := nji,
		have gr: group(quotient(range(j∘i))) := (@quotient_group.group K _inst_3 (@range K G (⇑j ∘ ⇑i)) nor),
		have _hom_f' := @quotient_group.is_group_hom K _ _ nor,
		have: f' = @quotient_group.mk K _ (range(j∘i)) (by apply_instance) := rfl,
		rw←this at _hom_f',
		change f'(j(a*b)) = _,--f'(j a) * f'(j b),
		rw[is_group_hom.mul j],
		tidy,
	end⟩,
	..embed_group.quot
}

private def normal_mk(N: set G)(h: is_subgroup N)(prf): normal_subgroup N := {normal:= prf}

instance normal_quot[nj: embed_normal H K][nji: @embed_normal G K _ _ (trans_comp i j)]: embed_normal(H./G)(K'G i j):= {
	normal:=normal_mk
		(range((embed_group.hom_quot: embed_groupₜ (@quot_by_embed H G _ _ i) _): (@quot_by_embed H G _ _ i)→(K'G i j)))
		(begin
			have: is_group_hom((embed_group.hom_quot: embed_groupₜ (@quot_by_embed H G _ _ i) _): (@quot_by_embed H G _ _ i)→(K'G i j)),
				apply_instance,
			apply @is_group_hom.range_subgroup _ _ _ _ _ this,
		end)
		(begin
			intros,
			induction n,
			induction g,
			let f': K → K'G i j := @quotient_group.mk K _ (range(j∘i)) (by apply_instance),
			change f' g * f' n * (f' g)⁻¹ ∈ _,
			tactic.unfreeze_local_instances,
			rcases nji,
			have nor: normal_subgroup(range(j∘i)) := nji,
			let gr: group(quotient(range(j∘i))) := (@quotient_group.group K _inst_3 (@range K G (⇑j ∘ ⇑i)) nor),
			have _hom_f' := @quotient_group.is_group_hom K _ _ nor,
			have: f' = @quotient_group.mk K _ (range(j∘i)) (by apply_instance) := rfl,
			rw←this at _hom_f',
			have: gr = quotient_group.group(range(j∘i)) := rfl,
			simp[this] at *,
			rcases H_1 with ⟨⟨m⟩,e⟩,
			have e': f' n = f'(j m) := e.symm,
			rw e',
			rw[←@is_group_hom.mul _ _ _ _ f' _hom_f', ←@is_group_hom.inv _ _ _ _ f' _hom_f', ←@is_group_hom.mul _ _ _ _ f' _hom_f'],
			rcases nj.normal,
			rcases normal (j m) _ g with ⟨n',el⟩,
			exact⟨n', by tidy⟩,
			tidy,
		end)
}

end embed_group

open embed_group

/-The outcome of the attempt 2: class inference fails and the cause is very difficult to locate.
set_option trace.class_instances true
theorem isomorphism_theorem_3
	[j: embed_groupₜ H K]
	[embed_normal H K]
	[i: embed_group G H]
	[embed_normal G K]: --[@embed_normal G K _ _ (trans_comp i j)]:
		(K./G) ≅ K./H ∨
    true
    --(@quot_by_embed K G _ _ (trans_comp i j))./(H./G) ≅ K./H
	:= sorry
--/

end group_equiv

namespace group_equiv

--–3. attempt: embeddings with packing preferred over classes

structure Group := (base: Type*) (struct: group base)
variables{G: Group}{H: Group}{K: Group}

def 𝔾(G: Type*)[g: group G]: Group := ⟨G,g⟩

instance Group_to_Type: has_coe_to_sort Group := {S:=Type*, coe:= λG, G.base}
instance: group G := G.struct

structure group_homs(G H : Group) := (fn: G→H) (hom: is_group_hom fn)
infixr ` ⇒ ` := group_homs

instance homs_to_fun: has_coe_to_fun(group_homs G H) :={
	F:= λ_, G→ H,
	coe:= group_homs.fn
}

instance packed_is_group_hom{f: G⇒H}: is_group_hom f := f.hom

def compose(f: H⇒K)(g: G⇒H): G⇒K := ⟨f ∘ g, @is_group_hom.comp _ _ _ _ g g.hom _ _ f f.hom⟩

@[simp]lemma compose_fn(f: H⇒K)(g: G⇒H): (compose f g).fn = f.fn ∘ g.fn := rfl

--Is type class conditional coercion possible?
--instance sub_to_Group{S: set G}[is_subgroup S]: has_coe(set G)(Group) := ⟨λS, ⟨S, ??⟩⟩
def subGroup(S: set G)[is_subgroup S]: Group := ⟨S, infer_instance⟩

class embₜ(G H : Group) extends group_homs G H := (inj: injective fn)
class emb(G H : Group) extends group_homs G H := (inj: injective fn)--embₜ G H := unit --Prefer explicit instances so that base conversion can be ordered to be tried before transitivity.

namespace emb
variables[i₁: emb G H][i: embₜ G H][j: embₜ H K]

instance: has_coe(embₜ G H)(group_homs G H) := ⟨λi,{..i}⟩

instance sub{S: set G}[is_subgroup S]: emb (subGroup S) G := {hom:= by tidy, ..embed.set}

instance: embₜ G K := {
	fn:= j ∘ i₁.fn,
	inj:=begin
		have:= i₁.inj,
		have:= j.inj,
		tidy,
	end,
	hom:= @is_group_hom.comp _ _ _ _ _ i₁.hom _ _ _ j.hom,
}
instance base: embₜ G H := {..i₁}

instance: is_group_hom i := i.hom

class normally(G H : Group)[i: embₜ G H] := (normal: normal_subgroup(range i))

@[reducible]def quot_by_embed(H G : Group)[i: embₜ G H][normally G H]: Group := ⟨quotient_group.quotient(range i), begin
	have:= _inst_1.normal,
	apply @quotient_group.group _ _ _ this,
end⟩
infix `. ̸`:70 := quot_by_embed

instance[normally G H]: normal_subgroup(range i) := begin
	tactic.unfreeze_local_instances,
	rcases _inst_1,
	assumption,
end

protected def lift(f: H⇒K)(fG_1: ∀g, f(i g) = 1)[normally G H]: H. ̸G ⇒ K := let iG: set H := range i in ⟨@quotient_group.lift H H.struct iG _ K K.struct f f.hom (by tidy), @quotient_group.is_group_hom_quotient_lift H _ iG _ K _ f f.hom (by tidy)⟩

--When stating theorems e.g. here one wants to assume G ↪ͭ H ↪ͭ K both transitively and G ⊴ K which requires G ↪ͭ K to be inferred. This is impossible (I think). A workaround is to write helpers that assume G ↪¹ H in one step and then convert these to the desired form using atomic_trans.
def atomic_trans{R: emb G H → Sort*}(F: Πi₁: emb G H, R i₁)[i: embₜ G H] := F{..i}

def instance_normally(i₁: emb G H)[j: embₜ H K][normally G K]: normally G H :=⟨⟨begin
	intros,
	have:= _inst_1.normal.normal,
	have:= this(j n)(by tidy)(j g),
	rw[←is_group_hom.inv j,←is_group_hom.mul j,←is_group_hom.mul j] at this,
	rcases this with ⟨m,e⟩,
	exact⟨m, begin
		apply j.inj,
		apply e,
	end⟩,
end⟩⟩
instance:= @atomic_trans G H _ (@instance_normally G H K)

def instance_emb(i₁: emb G H)[j: embₜ H K][normally G K]: emb(H. ̸G)(K. ̸G) :={
	inj:=begin
		unfold injective,
		intros,
		induction a₁,
		induction a₂,
		apply quot.sound,
		have: quotient_group.mk(j a₁) = quotient_group.mk(j a₂) := a,
		change a₁⁻¹ * a₂ ∈ range _,
		have: j(a₁⁻¹ * a₂) ∈ range _,
			rw[is_group_hom.mul j, is_group_hom.inv j],
			simp[quotient_group.mk] at this,
			exact this,
		rcases this with ⟨g,e⟩,
		have ji:= j.inj, unfold injective at ji,
		exact⟨g, by tidy⟩,
	refl,refl,end,
	..emb.lift(compose (⟨quotient_group.mk, by apply_instance⟩: K⇒K. ̸G) {..j}) (λg,begin
		change (compose _ _).fn(i₁.fn g) = 1,
		simp,
		rw(_: (1:K. ̸G) = quotient_group.mk 1),
		apply eq.symm,
		apply quot.sound,
		change (1:K)⁻¹ * _ ∈ range _,
		tidy,
	end),
}
instance emb_quot_quot:= @atomic_trans G H _ (@instance_emb G H K)

def instance_emb_normal(i₁: emb G H)[j: embₜ H K][normally H K][normally G K]: normally(H. ̸G)(K. ̸G) := ⟨⟨begin
	intros,
	have: group K := K.struct,
	induction n,
	induction g,
	change quotient_group.mk _ * quotient_group.mk _ * (quotient_group.mk _)⁻¹ ∈ _,
	rw[←is_group_hom.inv(@quotient_group.mk K K.struct _ _),←is_group_hom.mul (@quotient_group.mk K K.struct _ _),←is_group_hom.mul (@quotient_group.mk K K.struct _ _)],
	rcases H_1 with ⟨x,e⟩,
	induction x,
	change quotient_group.mk _ = quotient_group.mk _ at e,
	simp[quotient_group.mk] at e,
	change _⁻¹ * n ∈ range _ at e,
	rcases e with ⟨m,h⟩,
	have ne: n = _ * _,
		apply inv_mul_eq_iff_eq_mul.mp,
		exact h.symm,
	change n = j x * j(i₁.fn m) at ne,
	rw[←is_group_hom.mul j] at ne,
	have:= _inst_1.normal.normal,
	rcases this n (by tidy) g,
	exact⟨quotient_group.mk w, begin
		change quotient_group.mk(j _) = _,
		apply congr_arg,
		exact h_1,
	end⟩,
	tidy,
end⟩⟩
instance normal_quot_quot:= @atomic_trans G H _ (@instance_emb_normal G H K)

end emb
open emb
open group_equiv

def quotient_preserves_isom{S N : set G}[normal_subgroup S][normal_subgroup N](SeN: S = N): quotient S ≅ quotient N := via_biject_hom
	(quotient_group.lift S quotient_group.mk (begin--well defined
		intros,
		tactic.unfreeze_local_instances,
		subst SeN,
		change _ = quotient_group.mk _,
		apply eq.symm,
		simp[quotient_group.mk],
		change _*x ∈ _,
		simpa,
	end))
	(begin--bijective
		tidy,
				change quotient_group.mk _ = quotient_group.mk _ at a,
				change quotient_group.mk _ = quotient_group.mk _,
				tactic.unfreeze_local_instances,
				subst SeN,
				apply a,
			exact quotient_group.mk b,
		refl,
	end)
	(by apply_instance)

private def f[emb G H][embₜ H K][normally H K][normally G K]: K. ̸G ⇒ K. ̸H :=
	emb.lift ⟨quotient_group.mk, by tidy⟩ begin
		intros,
		change quotient_group.mk _ = quotient_group.mk _,
		apply eq.symm,
		apply quot.sound,
		tidy,
	end

--The third isomorphism theorem. Use isomorphism_theorem_3 below that has the same type of quot_quot except that [embₜ G H] is inferred instead of explicit i₁. Unfortunately the type signature of isomorphism_theorem_3 can't be stated due to transitivity inference problems.
def quot_quot(i₁: emb G H)[j: embₜ H K][normally H K][normally G K]: (K. ̸G) . ̸ (H. ̸G) ≅ K. ̸H
:=begin
	have qk:= quotient_ker_isom_of_surjective f.fn (λx:K. ̸H, begin
		induction x,
		change ∃ y: K. ̸G, f.fn y = quotient_group.mk x,
		exact⟨quotient_group.mk x, begin
			simp[f, emb.lift],
			refl,
		end⟩,
		refl,
	end),
	let J: embₜ (H. ̸G) (K. ̸G) := infer_instance,
	have k: ker f.fn = range J,
		ext,
		induction x,
		simp[ker, f, emb.lift],
		change quotient_group.mk _ = quotient_group.mk _ ↔ _,
		have: (quotient_group.mk x = quotient_group.mk 1) = (quotient_group.mk 1 = quotient_group.mk x),
			ext, constructor; apply eq.symm,
		rw this,
		simp[quotient_group.mk],
		change _ * x ∈ _ ↔ _,
		simp,
		constructor;intro h; rcases h with ⟨y,jyx⟩,
			exact⟨quotient_group.mk y, begin
				rw←jyx,
				refl,
			end⟩,
		induction y,
		change quotient_group.mk _ = quotient_group.mk _ at jyx,
		simp[quotient_group.mk] at jyx,
		change _ * _ ∈ _ at jyx,
		rcases jyx with ⟨z,e⟩,
		have xe: x = _ * _,
			apply inv_mul_eq_iff_eq_mul.mp,
			exact e.symm,
		change x = j _ * j _ at xe,
		rw[←is_group_hom.mul j] at xe,
		exact⟨y*_, by rw xe;refl⟩,
		refl,refl,
	apply flip group_equiv.trans qk,
	change quotient_group.quotient _ ≅ _,
	have: is_subgroup(range J), apply_instance,
	have: is_subgroup(ker f.fn) := @is_group_hom.preimage (K. ̸G) (K. ̸H) _ _ f.fn f.hom (is_subgroup.trivial _) _,
	apply quotient_preserves_isom,
	apply k.symm,
	apply_instance,
	exact f.hom,
end
def isomorphism_theorem_3 := @atomic_trans G H _ (@quot_quot G H K)
#check @isomorphism_theorem_3

end group_equiv

/-Problem with evaluating this: basic examples are add_groups and I don't know how to transfer them into (multiplicative) groups.
namespace basic_embeddings
open group_equiv

instance ℤsubℚ: emb (𝔾 ℤ) (𝔾 ℚ)

end basic_embeddings
--/


import data.list
import data.list.func

universe u

theorem get_succ {α : Type u} [inhabited α]
  : ∀ (l : list α) (n : ℕ),
  list.func.get n.succ l = list.func.get n l.tail :=
begin intros, cases l, simp, simp, end

theorem get_0_head {α : Type u} [inhabited α] (l : list α)
  : list.func.get 0 l = list.head l :=
begin cases l, simp, simp, end

lemma list.sum_tl_hd {l : list ℕ} : l.sum = l.tail.sum + l.head :=
begin
  cases l with h t, refl, simp, apply add_comm,
end

lemma list.sum_update (x : ℕ) : ∀ (l : list ℕ) (n : ℕ),
∃ c, l.sum = c + (list.func.get n l)
∧ (list.func.set x l n).sum = c + x
| l 0 := begin
  existsi l.tail.sum,
  split,
  { rw get_0_head, exact list.sum_tl_hd, },
  {
    have : ∀ y, y + x = y + (list.func.set x l 0).head, by simp [←get_0_head],
    rw this,
    have : l.tail = (list.func.set x l 0).tail,
    { cases l, simp, simp, },
    rw this,
    exact list.sum_tl_hd,
  }
end
| [] (n+1) := begin
  rcases list.sum_update [] n with ⟨c, IH1, IH2⟩,
  existsi c, split, {
    have : list.func.get (n + 1) list.nil = list.func.get n list.nil,
    rw [list.func.get_nil, list.func.get_nil],
    rw this, exact IH1,
  }, {
    simp [default, IH2],
  }
end
| (h::t) (n+1) := begin
  rcases list.sum_update t n with ⟨c, IH1, IH2⟩,
  existsi h+c, simp, split, {
    rw IH1, exact (add_assoc _ _ _).symm,
  }, {
    rw IH2, exact (add_assoc _ _ _).symm,
  }
end

lemma list.set_map {α β : Type} [inhabited α] [inhabited β]
(a : α) (f : α → β) (Hdf : default β = f (default α)) : ∀ (l : list α) (n : ℕ),
list.func.set (f a) (list.map f l) n = list.map f (list.func.set a l n)
| [] 0 := by simp
| (h::t) 0 := by simp
| [] (n+1) := begin
  simp, split, exact Hdf,
  exact list.set_map [] n,
end
| (h::t) (n+1) := begin
  simp, exact list.set_map t n,
end

lemma list.sum_map_update {α : Type} [inhabited α]
(f : α → ℕ) (Hdf : f (default α) = 0) (a : α) (l : list α) (n : ℕ)
: ∃ c, (l.map f).sum = c + f (list.func.get n l)
∧ ((list.func.set a l n).map f).sum = c + (f a)
:=
begin
  rcases list.sum_update (f a) (list.map f l) n
  with ⟨c, H1, H2⟩, existsi c, split,
  { rw H1, rw list.func.get_map', exact Hdf, },
  { rw ←H2, rw list.set_map, exact Hdf.symm, },
end


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Indexed product of uniform spaces
-/

protected instance Pi.uniform_space {ι : Type u_1} (α : ι → Type u)
    [U : (i : ι) → uniform_space (α i)] : uniform_space ((i : ι) → α i) :=
  uniform_space.of_core_eq uniform_space.to_core Pi.topological_space sorry

theorem Pi.uniformity {ι : Type u_1} (α : ι → Type u) [U : (i : ι) → uniform_space (α i)] :
    uniformity ((i : ι) → α i) =
        infi
          fun (i : ι) =>
            filter.comap
              (fun (a : ((i : ι) → α i) × ((i : ι) → α i)) => (prod.fst a i, prod.snd a i))
              (uniformity (α i)) :=
  infi_uniformity

theorem Pi.uniform_continuous_proj {ι : Type u_1} (α : ι → Type u)
    [U : (i : ι) → uniform_space (α i)] (i : ι) :
    uniform_continuous fun (a : (i : ι) → α i) => a i :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (uniform_continuous fun (a : (i : ι) → α i) => a i))
        (propext uniform_continuous_iff)))
    (infi_le (fun (j : ι) => uniform_space.comap (fun (a : (i : ι) → α i) => a j) (U j)) i)

protected instance Pi.complete {ι : Type u_1} (α : ι → Type u) [U : (i : ι) → uniform_space (α i)]
    [∀ (i : ι), complete_space (α i)] : complete_space ((i : ι) → α i) :=
  sorry

protected instance Pi.separated {ι : Type u_1} (α : ι → Type u) [U : (i : ι) → uniform_space (α i)]
    [∀ (i : ι), separated_space (α i)] : separated_space ((i : ι) → α i) :=
  iff.mpr separated_def
    fun (x y : (i : ι) → α i)
      (H :
      ∀ (r : set (((i : ι) → α i) × ((i : ι) → α i))),
        r ∈ uniformity ((i : ι) → α i) → (x, y) ∈ r) =>
      funext
        fun (i : ι) =>
          uniform_space.eq_of_separated_of_uniform_continuous (Pi.uniform_continuous_proj α i) H

end Mathlib


THIS IS DEPRECATED

SEE VERSION IN REPO THAT ABHI AND I HAVE

import analysis.real
import tactic.norm_num
import xenalib.decimal_expansions
import xenalib.mathlib_someday
import order.bounds

-- #check is_lub -- set α → α → Prop

-- M1F 2018, Q2

-- {x<59} has a LUB and find it
-- (0.7<x<0.9 and no 8) has LUB

-- b is UB(S) and b in S then B=LUB(S)

-- LUB(S)=b and LUB(T)=c -> LUB(S+T)=b+c

-- part (a)
definition is_upper_bound (S : set ℝ) (x : ℝ) := ∀ s ∈ S, s ≤ x
definition is_bounded_above (S : set ℝ) := ∃ x, is_upper_bound S x
-- Johannes -- what did he say
definition is_lub' (S : set ℝ) (x : ℝ) := is_upper_bound S x ∧
  ∀ y : ℝ, is_upper_bound S y → x ≤ y
example : is_lub' = is_lub := rfl

definition has_lub (S : set ℝ) := ∃ x, is_lub S x

-- part (b)
theorem nonempty_and_bounded_of_has_LUB (S : set ℝ) (H : has_lub S) :
  (S ≠ ∅) ∧ (∃ x, is_upper_bound S x) :=
begin
  cases H with b Hb,
  -- b is LUB, Hb is proof it's LUB
  split,
  { intro Hempty,
    -- b is LUB of S, and S is empty.
    -- seek contradiction.
    have H := Hb.2 (b - 1), -- b - 1 is an upper bound
    have Hub : is_upper_bound S (b - 1),
    { intros s Hs,
      exfalso,
      rw Hempty at Hs,
      exact Hs,
    },
      have Hwrong := H Hub,
      revert Hwrong,
      norm_num,
  }  ,
  {
     existsi b,
     exact Hb.1
  }
end

-- part (c) (i)
definition Sci := {x : ℝ | x < 59}

-- #check @two_ne_zero

theorem helper_lemma (x y : ℝ) (H : x < y) : x < (x + y) / 2 ∧ (x + y) / 2 < y :=
begin
  have two_ge_zero : (2 : ℝ) ≥ 0 := by norm_num,
  split,
  { apply lt_of_mul_lt_mul_right _ two_ge_zero,
    rw [mul_two,div_mul_cancel],
    apply add_lt_add_left H,
    norm_num},
  { apply lt_of_mul_lt_mul_right _ two_ge_zero,
    rw [div_mul_cancel,mul_two],
    apply add_lt_add_right H,
    norm_num,
  },
end

example : is_lub Sci 59 :=
begin
  split,
  { intros s Hs,
    exact le_of_lt Hs,
  },
  { intros y Hy,
    apply le_of_not_gt,
    intro H,
    let s := (y + 59) / 2,
    have H1 : y < s := (helper_lemma _ _ H).1,
    have H2 : s < 59 := (helper_lemma _ _ H).2,
--    unfold is_upper_bound at Hy,
    have H1' := Hy s H2,
    exact not_le_of_lt H1 H1', --of_not_gt
  }
end

definition S : set ℝ := {x | 7/10 < x ∧ x < 9/10 ∧
  ∀ n : ℕ, decimal.expansion_nonneg x n ≠ 8}

-- c(ii) (0.7<x<0.9 and no 8) has LUB
theorem S_has_lub : has_lub S :=
begin
  unfold has_lub,
  refine ex_lub_of_nonempty_bdd S _ _,
  -- suffices to check non-empty and bounded
  show ∃ (x : ℝ), x ∈ S,
  { existsi (71/100 : ℝ), -- no decimals in Lean as far as I know
    unfold S,norm_num,-- 7/10 < 71/100 and 71/100 < 9/10 done by norm_num
    exact decimal.no_eights_in_0_point_71,
  },
  show ∃ (x : ℝ), ∀ (y : ℝ), y ∈ S → y ≤ x,
  { existsi (9/10 : ℝ),
    intros y Hy,
    exact le_of_lt Hy.2.1
  },
end

-- part d i
-- b is UB(S) and b in S then B=LUB(S)
theorem lub_of_ub_in (S : set ℝ) (b : ℝ) (Hub : is_upper_bound S b) (Hin : b ∈ S) :
  is_lub S b := ⟨Hub,λ y Hy,Hy b Hin⟩

/-
begin
  split,
    -- b is an upper bound:
    exact Hub,
    -- b is is at most any other upper bound
    -- revert Hin, -- ⊢ b ∈ S → b ∈ lower_bounds (upper_bounds S)
    -- is that in mathlib?
    intros y Hy,
    exact Hy b Hin,
end
-/

instance : has_add (set ℝ) := ⟨λ S T,{u | ∃ (s ∈ S) (t ∈ T), u = s + t}⟩

theorem lub_add (S T : set ℝ) (b c : ℝ) : is_lub S b → is_lub T c → is_lub (S + T) (b + c) :=
begin
  intros HSb HTc,
  split,
  { intros u Hu,rcases Hu with ⟨s,Hs,t,Ht,Hu⟩,rw Hu,
    refine add_le_add (HSb.1 _ Hs) (HTc.1 _ Ht),
  },
  { -- some kid in my exam gave this constructive proof
    intros d Hd,
    have H : ∀ s ∈ S, ∀ t ∈ T, t ≤ d - s,
      intros s Hs t Ht,
      have H2 := Hd (s + t) ⟨s,Hs,t,Ht,rfl⟩,
      exact le_sub_left_of_add_le H2,
    have H3 : ∀ s ∈ S, c ≤ d - s,
      intros s Hs,
      exact HTc.2 (d - s) (H s Hs),
    have H4 : ∀ s ∈ S, s ≤ d - c,
      intros s Hs,
      have xXX := H3 s Hs, -- c <= d - s
      exact le_sub.1 (H3 s Hs),
    have H5 : b ≤ d - c,
      exact HSb.2 (d - c) H4,
    exact add_le_of_le_sub_right H5,
  }
end

theorem lub_add'' (S T : set ℝ) (b c : ℝ) (HSb : is_lub S b) (HTc : is_lub T c) : is_lub (S + T) (b + c) :=
⟨λ u Hu, let ⟨s,Hs,t,Ht,Hu⟩ := Hu in by rw Hu;exact add_le_add (HSb.1 s Hs) (HTc.1 t Ht),
λ d Hd,add_le_of_le_sub_right $ HSb.2 _ $ λ s Hs,le_sub.1 $ HTc.2 _ $ λ t Ht,le_sub_left_of_add_le $ Hd _ ⟨s,Hs,t,Ht,rfl⟩
⟩

theorem lub_add' (S T : set ℝ) (b c : ℝ) (HSb : is_lub S b) (HTc : is_lub T c) : is_lub (S + T) (b + c) :=
⟨λ u Hu, let ⟨s,Hs,t,Ht,Hu⟩ := Hu in by rw Hu;exact add_le_add (HSb.1 s Hs) (HTc.1 t Ht),
 λ d Hd,add_le_of_le_sub_right $ HSb.2 (d - c) (λ s Hs,le_sub.1 ((λ s₁ Hs₁,HTc.2 _ (λ t Ht,le_sub_left_of_add_le $ Hd _ ⟨s₁,Hs₁,t,Ht,rfl -- the proof
   ⟩)) s Hs))⟩

-- LUB(S)=b and LUB(T)=c -> LUB(S+T)=b+c

-- TODO
-- 0.7<x<0.9 and no 8's

-- need a theorem that 0.71 has no 8s in decimal exapansion

--theorem last_past (S : set ℝ) (T : set ℝ) :


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import algebra.module.basic
import algebra.regular.smul
import algebra.ring.pi
import group_theory.group_action.pi

/-!
# Pi instances for modules

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

This file defines instances for module and related structures on Pi Types
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi

lemma _root_.is_smul_regular.pi {α : Type*} [Π i, has_smul α $ f i] {k : α}
  (hk : Π i, is_smul_regular (f i) k) : is_smul_regular (Π i, f i) k :=
λ _ _ h, funext $ λ i, hk i (congr_fun h i : _)

instance smul_with_zero (α) [has_zero α]
  [Π i, has_zero (f i)] [Π i, smul_with_zero α (f i)] :
  smul_with_zero α (Π i, f i) :=
{ smul_zero := λ _, funext $ λ _, smul_zero _,
  zero_smul := λ _, funext $ λ _, zero_smul _ _,
  ..pi.has_smul }

instance smul_with_zero' {g : I → Type*} [Π i, has_zero (g i)]
  [Π i, has_zero (f i)] [Π i, smul_with_zero (g i) (f i)] :
  smul_with_zero (Π i, g i) (Π i, f i) :=
{ smul_zero := λ _, funext $ λ _, smul_zero _,
  zero_smul := λ _, funext $ λ _, zero_smul _ _,
  ..pi.has_smul' }

instance mul_action_with_zero (α) [monoid_with_zero α]
  [Π i, has_zero (f i)] [Π i, mul_action_with_zero α (f i)] :
  mul_action_with_zero α (Π i, f i) :=
{ ..pi.mul_action _,
  ..pi.smul_with_zero _ }

instance mul_action_with_zero' {g : I → Type*} [Π i, monoid_with_zero (g i)]
  [Π i, has_zero (f i)] [Π i, mul_action_with_zero (g i) (f i)] :
  mul_action_with_zero (Π i, g i) (Π i, f i) :=
{ ..pi.mul_action',
  ..pi.smul_with_zero' }

variables (I f)

instance module (α) {r : semiring α} {m : ∀ i, add_comm_monoid $ f i}
  [∀ i, module α $ f i] :
  @module α (Π i : I, f i) r (@pi.add_comm_monoid I f m) :=
{ add_smul := λ c f g, funext $ λ i, add_smul _ _ _,
  zero_smul := λ f, funext $ λ i, zero_smul α _,
  ..pi.distrib_mul_action _ }

/- Extra instance to short-circuit type class resolution.
For unknown reasons, this is necessary for certain inference problems. E.g., for this to succeed:
```lean
example (β X : Type*) [normed_add_comm_group β] [normed_space ℝ β] : module ℝ (X → β) :=
infer_instance
```
See: https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Typeclass.20resolution.20under.20binders/near/281296989
-/
/-- A special case of `pi.module` for non-dependent types. Lean struggles to elaborate
definitions elsewhere in the library without this. -/
instance _root_.function.module (α β : Type*) [semiring α] [add_comm_monoid β] [module α β] :
  module α (I → β) :=
pi.module _ _ _

variables {I f}

instance module' {g : I → Type*} {r : Π i, semiring (f i)} {m : Π i, add_comm_monoid (g i)}
  [Π i, module (f i) (g i)] :
  module (Π i, f i) (Π i, g i) :=
{ add_smul := by { intros, ext1, apply add_smul },
  zero_smul := by { intros, ext1, apply zero_smul } }

instance (α) {r : semiring α} {m : Π i, add_comm_monoid $ f i}
  [Π i, module α $ f i] [∀ i, no_zero_smul_divisors α $ f i] :
  no_zero_smul_divisors α (Π i : I, f i) :=
⟨λ c x h, or_iff_not_imp_left.mpr (λ hc, funext
  (λ i, (smul_eq_zero.mp (congr_fun h i)).resolve_left hc))⟩

/-- A special case of `pi.no_zero_smul_divisors` for non-dependent types. Lean struggles to
synthesize this instance by itself elsewhere in the library. -/
instance _root_.function.no_zero_smul_divisors {ι α β : Type*} {r : semiring α}
  {m : add_comm_monoid β} [module α β] [no_zero_smul_divisors α β] :
  no_zero_smul_divisors α (ι → β) :=
pi.no_zero_smul_divisors _

end pi