import ring_theory.graded_algebra.basic
import ring_theory.graded_algebra.homogeneous_ideal

namespace graded_algebra

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

open_locale direct_sum big_operators

def nat_to_int : ℤ → submodule R A
| (int.of_nat n) := 𝓐 n
| (int.neg_succ_of_nat n) := ⊥

namespace nat_to_int

instance (n : ℕ) : unique (nat_to_int 𝓐 (int.neg_succ_of_nat n)) :=
{ default := 0,
  uniq := λ ⟨a, ha⟩, begin
    change a ∈ ⊥ at ha,
    simpa only [submodule.mem_bot, submodule.mk_eq_zero] using ha,
  end }

lemma supr_eq_top : (⨆ i, nat_to_int 𝓐 i) = ⊤ :=
have m : ∀ x, x ∈ supr 𝓐,
from λ x, (graded_algebra.is_internal 𝓐).submodule_supr_eq_top.symm ▸ submodule.mem_top,
begin
  ext a,
  split; intros ha,
  { trivial },
  { refine submodule.supr_induction 𝓐 (m a) (λ n x hx, _) _ _,
    { rw submodule.supr_eq_span,
      apply submodule.subset_span,
      exact set.mem_Union.mpr ⟨int.of_nat n, hx⟩, },
    { rw submodule.supr_eq_span,
      apply submodule.subset_span,
      exact set.mem_Union.mpr ⟨0, submodule.zero_mem _⟩, },
    { intros x y hx hy,
      exact submodule.add_mem _ hx hy, }, },
end

lemma one_mem' : (1 : A) ∈ (nat_to_int 𝓐 0) :=
begin
  have triv : (0 : ℤ) = int.of_nat 0 := rfl,
  rw triv,
  change _ ∈ 𝓐 0,
  exact set_like.graded_monoid.one_mem,
end

lemma mul_mem' ⦃i j : ℤ⦄ {gi gj : A}
  (hi : gi ∈ nat_to_int 𝓐 i) (hj : gj ∈ nat_to_int 𝓐 j) :
  gi * gj ∈ nat_to_int 𝓐 (i + j) :=
begin
  cases i; cases j,
  { change _ ∈ 𝓐 i at hi,
    change _ ∈ 𝓐 j at hj,
    change _ ∈ 𝓐 (i + j),
    exact set_like.graded_monoid.mul_mem hi hj },
  { change _ ∈ ⊥ at hj,
    rw [submodule.mem_bot] at hj,
    subst hj,
    rw [mul_zero],
    exact submodule.zero_mem _ },
  { change _ ∈ ⊥ at hi,
    rw [submodule.mem_bot] at hi,
    subst hi,
    rw [zero_mul],
    exact submodule.zero_mem _ },
  { change _ ∈ ⊥ at hi,
    rw [submodule.mem_bot] at hi,
    subst hi,
    rw [zero_mul],
    exact submodule.zero_mem _ },
end

def add_hom_nat_to_int : (⨁ i, 𝓐 i) →+ (⨁ i, nat_to_int 𝓐 i) :=
{ to_fun := direct_sum.to_add_monoid begin
    rintro n,
    refine { to_fun := _, map_zero' := _, map_add' := _ },
    { intros a, refine direct_sum.of _ (int.of_nat n) _, exact a, },
    { rw [map_zero], },
    { intros a b, rw [map_add], },
  end,
  map_zero' := by rw [map_zero],
  map_add' := λ x y, begin
    dsimp only,
    rw [map_add],
  end }

def add_hom_int_to_nat : (⨁ i, nat_to_int 𝓐 i) →+ (⨁ i, 𝓐 i) :=
{ to_fun := direct_sum.to_add_monoid $ begin
    rintro n,
    cases n,
    { refine { to_fun := _, map_zero' := _, map_add' := _},
      { exact λ x, direct_sum.of _ n x, },
      { rw map_zero },
      { intros x y,
        simp [map_add] }, },
    { exact 0 },
  end,
  map_zero' := by simp only [map_zero],
  map_add' := λ x y, by simp [map_add] }

def equiv_nat_to_int : (⨁ i, 𝓐 i) ≃+ (⨁ i, nat_to_int 𝓐 i) :=
{ to_fun := add_hom_nat_to_int 𝓐,
  inv_fun := add_hom_int_to_nat 𝓐,
  left_inv := λ x, begin
    induction x using direct_sum.induction_on with i x x y hx hy,
    { simp [map_zero] },
    { simp only [add_hom_nat_to_int, add_hom_int_to_nat, add_monoid_hom.mk_coe, direct_sum.to_add_monoid_of],
      ext1 j,
      by_cases ineq1 : i = j,
      { subst ineq1,
        rw [direct_sum.of_eq_same, direct_sum.of_eq_same], },
      { rw [direct_sum.of_eq_of_ne, direct_sum.of_eq_of_ne];
        exact ineq1 }, },
    { rw [map_add, map_add, hx, hy], },
  end,
  right_inv := λ x, begin
    induction x using direct_sum.induction_on with i x x y hx hy,
    { simp [map_zero] },
    { cases i,
      { simp only [add_hom_nat_to_int, add_hom_int_to_nat, add_monoid_hom.mk_coe, direct_sum.to_add_monoid_of],
        erw [direct_sum.to_add_monoid_of], },
      { simp only [add_hom_int_to_nat, add_monoid_hom.mk_coe, direct_sum.to_add_monoid_of, add_monoid_hom.zero_apply, map_zero],
        have : x = 0,
        { have := x.2,
          change _ ∈ ⊥ at this,
          rw submodule.mem_bot at this,
          ext, },
        subst this,
        rw [map_zero], }, },
    { rw [map_add, map_add, hx, hy], },
  end,
  map_add' := λ x y, by simp [map_add] }

def decompose_to_int : A →+ ⨁ (i : ℤ), nat_to_int 𝓐 i :=
(equiv_nat_to_int 𝓐).to_add_monoid_hom.comp (graded_algebra.decompose 𝓐).to_add_equiv.to_add_monoid_hom

lemma decompose_to_int_apply_of_nat (i : ℕ) (a : A) :
  decompose_to_int 𝓐 a (int.of_nat i) = graded_algebra.decompose 𝓐 a i :=
have m : ∀ x, x ∈ supr 𝓐,
from λ x, (graded_algebra.is_internal 𝓐).submodule_supr_eq_top.symm ▸ submodule.mem_top,
begin
  refine submodule.supr_induction 𝓐 (m a) _ _ _,
  { intros j x hj,
    rw [graded_algebra.decompose_of_mem 𝓐 hj, decompose_to_int],
    simp only [add_monoid_hom.coe_comp, function.comp_app],
    erw [graded_algebra.decompose_of_mem 𝓐 hj],
    simp only [equiv_nat_to_int, add_hom_nat_to_int, add_monoid_hom.mk_coe],
    erw [direct_sum.to_add_monoid_of],
    by_cases ineq : i = j,
    { subst ineq,
      erw [direct_sum.of_eq_same, direct_sum.of_eq_same], },
    { erw [direct_sum.of_eq_of_ne _ _ _ _ (ne.symm ineq), direct_sum.of_eq_of_ne],
      contrapose! ineq,
      subst ineq, }, },
    { simp only [map_zero, direct_sum.zero_apply], },
    { intros x y hx hy,
      rw [map_add, map_add, direct_sum.add_apply, direct_sum.add_apply, hx, hy], },
end

lemma decompose_to_int_apply_of_neg_succ_of_nat (i : ℕ) (a : A) :
  decompose_to_int 𝓐 a (int.neg_succ_of_nat i) = 0 := by simp only [eq_iff_true_of_subsingleton]

lemma decompose_to_int_of_aux (a : ⨁ i, 𝓐 i) :
  decompose_to_int 𝓐 (direct_sum.coe_add_monoid_hom 𝓐 a) = add_hom_nat_to_int 𝓐 a :=
begin
  apply_fun (equiv_nat_to_int 𝓐).symm using (equiv_nat_to_int 𝓐).symm.injective,
  change _ = (equiv_nat_to_int 𝓐).symm ((equiv_nat_to_int 𝓐) a),
  simp only [decompose_to_int, add_monoid_hom.coe_comp, add_equiv.coe_to_add_monoid_hom, add_equiv.symm_apply_apply],
  convert graded_algebra.left_inv a,
end

lemma decompose_to_int_of_mem (i : ℤ) (a : A) (h : a ∈ nat_to_int 𝓐 i) :
  decompose_to_int 𝓐 a = direct_sum.of (λ i, nat_to_int 𝓐 i) i ⟨a, h⟩ :=
begin
  have eq1 : (direct_sum.coe_add_monoid_hom 𝓐) (graded_algebra.decompose 𝓐 a) = a := graded_algebra.right_inv a,
  have : decompose_to_int 𝓐 a = decompose_to_int 𝓐 ((direct_sum.coe_add_monoid_hom 𝓐) (graded_algebra.decompose 𝓐 a)),
  { rw eq1 },
  rw [this, decompose_to_int_of_aux],
  rw [add_hom_nat_to_int],
  simp only [add_monoid_hom.mk_coe],
  rw direct_sum.coe_add_monoid_hom at eq1,

  cases i,
  { change _ ∈ 𝓐 _ at h,
    rw graded_algebra.decompose_of_mem 𝓐 h,
    erw direct_sum.to_add_monoid_of, },
  { change a ∈ ⊥ at h,
    rw submodule.mem_bot at h,
    simp only [h, map_zero],
    generalize_proofs h2,
    have : (⟨0, h2⟩ : {x // x ∈ nat_to_int 𝓐 -[1+ i]}) = 0,
    { ext, refl, },
    rw this,
    simp only [map_zero], },
end

lemma left_inverse' : function.left_inverse (decompose_to_int 𝓐)
  (direct_sum.coe_add_monoid_hom (nat_to_int 𝓐)) := λ x,
begin
  induction x using direct_sum.induction_on with i x x y hx hy,
  { rw [map_zero],
    ext1 i,
    simp only [decompose, function.comp_app, map_zero, direct_sum.zero_apply], },
  { erw [direct_sum.coe_add_monoid_hom_of],
    cases i,
    { ext1 j,
      by_cases ineq : int.of_nat i = j,
      { subst ineq,
        erw [decompose_to_int_apply_of_nat, graded_algebra.decompose_of_mem 𝓐 x.2, direct_sum.of_eq_same, direct_sum.of_eq_same],
        ext,
        refl, },
      { cases j,
        { have ineq2 : i ≠ j,
          { contrapose! ineq, exact ineq },
          erw [decompose_to_int_apply_of_nat, direct_sum.of_eq_of_ne _ _ _ _ ineq],
          have := graded_algebra.decompose_of_mem_ne 𝓐 x.2 ineq2,
          simpa only [subtype.val_eq_coe, decompose_coe, submodule.coe_eq_zero] using this, },
        { simp only [eq_iff_true_of_subsingleton], }, }, },
    { have := x.2,
      change _ ∈ ⊥ at this,
      rw submodule.mem_bot at this,
      have eqz : x = 0,
      { ext, },
      change ↑x = _ at this,
      rw [this, eqz],
      simp only [map_zero], }, },
  { rw [map_add, map_add, hx, hy], },
end

lemma right_inverse' : function.right_inverse (decompose_to_int 𝓐)
  (direct_sum.coe_add_monoid_hom (nat_to_int 𝓐)) := λ a,
have m : ∀ x, x ∈ supr (nat_to_int 𝓐), from λ x, by rw [supr_eq_top 𝓐]; trivial,
begin
  refine submodule.supr_induction (nat_to_int 𝓐) (m a) _ _ _,
  { intros i a hi,
    rw [decompose_to_int_of_mem 𝓐 i a hi, direct_sum.coe_add_monoid_hom_of],
    refl, },
  { simp [map_zero] },
  { intros x y hx hy,
    rw [map_add, map_add, hx, hy], },
end

section

variable [Π (i : ℕ) (x : 𝓐 i), decidable (x ≠ 0)]

instance : graded_algebra (nat_to_int 𝓐) :=
{ one_mem := nat_to_int.one_mem' _,
  mul_mem := nat_to_int.mul_mem' _,
  decompose' := nat_to_int.decompose_to_int _,
  left_inv := nat_to_int.left_inverse' _,
  right_inv := nat_to_int.right_inverse' _, }

lemma decompose_eq (a : A) :
  graded_algebra.decompose (nat_to_int 𝓐) a = decompose_to_int 𝓐 a := rfl

lemma ideal.is_homogeneous_int_iff_is_homogeneous_nat (I : ideal A) :
  I.is_homogeneous (nat_to_int 𝓐) ↔ I.is_homogeneous 𝓐 :=
{ mp := λ hI i a ha, begin
    specialize hI (int.of_nat i) ha,
    convert hI,
    rw [decompose_eq, decompose_to_int_apply_of_nat],
  end,
  mpr := λ hI i a ha, begin
    cases i,
    { specialize hI i ha,
      convert hI,
      rw [decompose_eq, decompose_to_int_apply_of_nat], },
    { rw [decompose_eq, decompose_to_int_apply_of_neg_succ_of_nat, submodule.coe_zero],
      exact submodule.zero_mem _, },
  end }

end

end nat_to_int

end graded_algebra


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_sqineq_36azm9asqle36zsq
  (z a : ℝ) :
  36 * (a * z) - 9 * a^2 ≤ 36 * z^2 :=
begin
  suffices : 4 * (a * z) - a^2 ≤ 4 * z^2, nlinarith,
  suffices : 0 ≤ (a - 2 * z)^2, nlinarith,
  exact pow_two_nonneg (a - 2 * z),
end


/-
Defines truth values, atoms and interpretations
Defines the orderings for these types and provides mathlib instances for complete_lattices
Most of this file is uninterestingexcept for the first three definitions
Interpretations here are not bound to a particular program so most operations are undecidable
For a more restricted interpretation, see program.lean
-/

import data.fintype.order
import data.nat.basic -- Some basic simps
import order.complete_lattice
open list

-- set_option trace.simplify.rewrite true

inductive tv
| vtrue
| vundef
| vfalse
open tv
def atom := ℕ
instance : inhabited atom := nat.inhabited
def I := atom -> tv

namespace tv
  @[simp] def to_nat (a : tv) : ℕ := tv.cases_on a 3 2 1
  lemma to_nat.inj : function.injective to_nat := λ a b eq, begin
    cases a; cases b,
    any_goals {refl}, all_goals {simp at eq, contradiction},
  end
  @[simp] lemma tv_unnat_eq {a b : tv} : (tv.to_nat a) = (tv.to_nat b) <-> a = b :=  begin
      split, all_goals { assume h, cases a; cases b; simp at |- h; contradiction },
  end

  instance linear_order : linear_order tv := linear_order.lift tv.to_nat tv.to_nat.inj

  -- There are finite truth values
  instance fintype : fintype tv := {
    elems := {vfalse, vundef, vtrue},
    complete := λ a, by { cases a; simp }}

  def top : tv := vtrue
  lemma le_top (a : tv) : a <= tv.top := begin
      have h1 : a <= a := @nat.less_than_or_equal.refl a.to_nat,
      have h2 := nat.less_than_or_equal.step h1,
      have h3 := nat.less_than_or_equal.step h2,
      cases a,
      all_goals { finish },
  end
  def bot : tv := vfalse
  lemma bot_le (a : tv) : tv.bot <= a := begin
      have h1 := @nat.less_than_or_equal.refl vfalse.to_nat,
      have h2 := nat.less_than_or_equal.step h1,
      have h3 := nat.less_than_or_equal.step h2,
      cases a,
      all_goals { finish },
  end
  -- Not sure why mathlib doesn't define this for linearly ordered fintypes
  -- This proof is so stupid, there has to be a better way...
  instance bounded_order : bounded_order tv := {
    top := top,
    le_top := le_top,
    bot := bot,
    bot_le := bot_le,
  }
  @[reducible]
  noncomputable instance complete_linear_order : complete_linear_order tv := fintype.to_complete_linear_order tv
  @[reducible]
  noncomputable instance complete_lattice : complete_lattice tv := complete_linear_order.to_complete_lattice tv
  def sup := @max tv
  instance has_sup : has_sup tv := ⟨tv.sup⟩
  def inf := @min tv
  instance has_inf : has_inf tv := ⟨tv.inf⟩
  @[reducible]
  noncomputable def Sup := tv.complete_lattice.Sup
  @[reducible]
  noncomputable instance has_Sup : has_Sup tv := ⟨tv.Sup⟩
  @[reducible]
  noncomputable def Inf := tv.complete_lattice.Inf
  @[reducible]
  noncomputable instance has_Inf : has_Inf tv := ⟨tv.Inf⟩
end tv

namespace atom
  instance decidable_eq : decidable_eq atom := nat.decidable_eq
end atom

namespace I
  structure less_than_or_equal  (i1 : I) (i2 : I) : Prop :=
    (p : Π a : atom, (i1 a) <= (i2 a))

  instance : has_le I := ⟨I.less_than_or_equal⟩
  structure less_than (i1 : I) (i2 : I) : Prop :=
    (p : i1 <= i2) (q : ∃a : atom, (i1 a) < (i2 a))
  instance : has_lt I := ⟨I.less_than⟩
  lemma not_lt_exists {i1 i2 : I} (h : ¬i1 <= i2) : ∃ a : atom, (i2 a) < (i1 a) := begin
    by_contradiction exis,
    rw not_exists at exis,
    -- Not sure why I can't write simp as `rw not_lt at exis`
    -- not_lt relies on tv.linear_order so it's probably doing the conversion but not tracing it
    simp at exis,
    have le : i1 <= i2 := ⟨ exis ⟩,
    exact h le,
  end

  def sup (i1 i2 : I) : I := λ a, tv.sup (i1 a) (i2 a)
  def inf (i1 i2 : I) : I := λ a, tv.inf (i1 a) (i2 a)
  @[reducible]
  noncomputable def Sup (S : set I) : I := λ a, tv.Sup (set.image (λ i : I, i a) S)
  @[reducible]
  noncomputable def Inf (S : set I) : I := λ a, tv.Inf (set.image (λ i : I, i a) S)
  def top : I := λ a : atom, vtrue
  def bot : I := λ a : atom, vfalse

end I

namespace tv
  -- Logical conjunction of a list of truth values
  def conj (l : list tv) : tv := foldl tv.inf tv.vtrue l
  -- Logical disjunction of a list of truth values
  def disj (l : list tv) : tv := foldl tv.sup tv.vfalse l
  -- Logical complement of a list of truth values
  @[simp, reducible] def neg (v : tv) : tv := tv.cases_on v tv.vfalse tv.vundef tv.vtrue
  instance : has_neg tv := ⟨neg⟩
  def negl (l : list tv) : list tv := map tv.neg l
  lemma neg_antitone : antitone tv.neg := λ a b c, begin
    by_cases b.neg = a.neg, exact (eq.symm h).ge,
    cases a; cases b,
    any_goals {contradiction}, any_goals {exact c},
    any_goals {exact nat.lt_succ_iff.mp c}, any_goals {exact nat.pred_le_iff.mp c},
  end
  lemma foldl_remove_default (hd : tv) {tl : list tv} : foldl min ⊤ (hd::tl) = foldl min hd tl := by { simp }
  lemma foldl_min_extract {a : tv} {l : list tv} : foldl min a l = min a (foldl min ⊤ l) := begin
    cases l, simp,
    rw foldl_remove_default,
    unfold foldl,
    exact foldl_assoc,
  end
end tv

namespace I
  def eval (self : I) (atoms : list atom) : list tv := map self atoms
  lemma unfold_eval (self : I) {a : atom} {tl : list atom} : (self.eval (a::tl)) = (self a) :: (self.eval tl) := begin unfold I.eval, simp, end
  def assign (self : I) (a : atom) (v : tv) : I := λ b, if a = b then v else self b
  def assign' (a : atom) (v : tv) : I -> I := λ i, i.assign a v
  lemma assign_eq_assign' {i : I} {a : atom} {v : tv} : (i.assign a v) = I.assign' a v i := rfl

  lemma assign_noop (self : I) (c : atom) : self = self.assign c (self c) := begin
    unfold I.assign, ext1, split_ifs,
    exact congr_arg self (eq.symm h),
    refl,
  end
  lemma assign_step {i1 i2 : I} {a : atom} {v1 v2 : tv} (i_le : i1 <= i2) (v_le : v1 <= v2) : (i1.assign a v1) <= (i2.assign a v2) := begin
    apply I.less_than_or_equal.mk, assume b,
    unfold I.assign,
    split_ifs,
    exact v_le,
    exact i_le.p b,
  end
  def neg (self : I) : I := λ a, tv.neg (self a)
  instance has_neg : has_neg I := ⟨I.neg⟩
  @[simp] lemma neg_eval {self : I} {atoms : list atom} : (tv.negl (self.eval atoms)) = ((-self).eval atoms) := map_map tv.neg self atoms
  -- Need to move to a location that has access to I.complete_lattice, but I don't have a use for this yet anyways.
  -- lemma neg_antitone : antitone neg := λ a b c, I.less_than_or_equal.mk (λ atom, tv.neg_antitone (c.p atom))
end I


/-
Copyright (c) 2020 Kevin Buzzard
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, and whoever else wants to join in.
-/

import affine_algebraic_set.regular_function

-- we want k-algebra homomorphisms
import ring_theory.algebra

-- we want facts about k-algebra homs that aren't in mathlib
import for_mathlib.ring_theory.algebra

/-!

# Regular maps

Definition and basic properties of regular maps

-/

/-
  KB mathematician-friendly notation attempt
-/
local notation `subset_of` := set

variables {k : Type*} [comm_ring k] {m : Type*} {n : Type*} {p : Type*}

local notation `k[m]` := mv_polynomial m k
local notation `k[n]` := mv_polynomial n k
local notation `k[p]` := mv_polynomial p k
local notation `𝔸ᵐ` := m → k
local notation `𝔸ⁿ` := n → k
local notation `𝔸ᵖ` := p → k

-- For me(kmb), "function" and "map" are strongly synonymous and I find it difficult
-- to remember which is which when it comes "regular functions" and "regular maps".
-- However I do know that I'm trying to construct the category of affine algebraic sets
-- over an algebraically closed field k so this should inform what we should be proving.

-- We use polynomials
open mv_polynomial

-- We're proving theorems about affine algebraic sets so their names
-- should go in the affine algebraic set namespace
namespace affine_algebraic_set

variables {V : affine_algebraic_set k m} {W : affine_algebraic_set k n}
variables {Y : affine_algebraic_set k p} -- X gets confused with mv_polynomial.X
local notation `k[V]` := regular_fun V
local notation `k[W]` := regular_fun W
local notation `k[Y]` := regular_fun Y

-- There are several equivalent definitions of a regular map. We begin
-- by defining them and showing their equivalence.

def is_morphism1 (φ : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ)) : Prop :=
∃ F : n → k[V], ∀ (v : (V : subset_of 𝔸ᵐ)) (i : n), (φ v : 𝔸ⁿ) i = F i v

def is_morphism2 (φ : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ)) : Prop :=
∃ Φ : k[n] →ₐ[k] k[V], ∀ (v : (V : subset_of 𝔸ᵐ)) (i : n), (φ v : 𝔸ⁿ) i = Φ (X i) v

def is_morphism3 (φ : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ)) : Prop :=
∃ Φ : k[n] →ₐ[k] k[V], ∀ (v : (V : subset_of 𝔸ᵐ)) (G : k[n]), G.eval (φ v) = (Φ G) v

def is_morphism4 (φ : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ)) : Prop :=
∃ φstar : k[W] →ₐ[k] k[V], ∀ (v : (V : subset_of 𝔸ᵐ)) (g : k[W]), g (φ v) = (φstar g) v

variable (φ : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ))

lemma four_implies_three : is_morphism4 φ → is_morphism3 φ :=
begin
  rintro ⟨φstar, hstar⟩,
  use alg_hom.comp φstar mv_polynomial.to_regular_fun_algebra_map,
  intros v G,
  exact hstar v (to_regular_fun.to_fun G),
end

lemma three_implies_two : is_morphism3 φ → is_morphism2 φ :=
begin
  rintro ⟨Φ, hΦ⟩,
  use Φ,
  intros v i,
  rw [←hΦ v (X i), eval_X],
end

lemma two_implies_one : is_morphism2 φ → is_morphism1 φ :=
begin
  rintro ⟨Φ, hΦ⟩,
  use (λ i, Φ (X i)),
  intros v i,
  exact hΦ v i,
end

lemma one_implies_two : is_morphism1 φ → is_morphism2 φ :=
begin
  rintro ⟨F, hF⟩,
  unfold is_morphism2,
  -- eval₂ gives the map
  let Φ.to_fun : mv_polynomial n k → regular_fun V := eval₂ (mv_polynomial.to_regular_fun.to_fun ∘ C) F,
  -- now need that it's a k-algebra hom.
  letI Φ.is_ring_hom : is_ring_hom Φ.to_fun := eval₂.is_ring_hom _ _,
  letI Φ.is_semiring_hom : is_semiring_hom Φ.to_fun := is_ring_hom.is_semiring_hom _,
  letI foo : is_semiring_hom (to_regular_fun.to_fun ∘ C : k → k[V]) := is_semiring_hom.comp _ _,
  let Φ.ring_hom := @ring_hom.of _ _ _ _ Φ.to_fun Φ.is_semiring_hom,
  let Φ : mv_polynomial n k →ₐ[k] regular_fun V :=
    { to_fun := Φ.to_fun,
      commutes' := begin
        intro t,
        show eval₂ (to_regular_fun.to_fun ∘ C : k → k[V]) F (C t) = _,
        convert eval₂_C _ _ _,
        exact foo,
      end,
      ..Φ.ring_hom},
  use Φ,
  intros v i,
  rw hF,
  apply congr_fun,
  apply congr_arg,
  show _ = eval₂ (to_regular_fun.to_fun ∘ C) F (X i),
  convert (eval₂_X _ _ _).symm,
  exact foo,
end

lemma two_implies_three : is_morphism2 φ → is_morphism3 φ :=
begin
  rintro ⟨Φ, hΦ⟩,
  use Φ,
  intros v G,
  replace hΦ := hΦ v,
  apply mv_polynomial.induction_on G,
  { intro a,
    rw eval_C,
    show a = (Φ (algebra_map (mv_polynomial n k) a)) v,
    rw alg_hom.commutes Φ a,
    show a = (C a : k[m]).eval v,
    rw eval_C,
  },
  { intros p q hp hq,
    rw [eval_add, hp, hq, alg_hom.map_add],
    refl
  },
  { intros p i h,
    rw [eval_mul, h, eval_X, hΦ, alg_hom.map_mul],
    refl
  }
end

lemma three_implies_four : is_morphism3 φ → is_morphism4 φ :=
begin
  rintro ⟨Φ,hΦ⟩,
  have hI : ∀ f : k[n], f ∈ 𝕀 W → Φ f = 0,
  { intros f hf,
    ext v,
    rw ←hΦ,
    rw mem_𝕀_iff at hf,
    rw hf,
    refl,
    exact (φ v).2
  },
  have hfΦ : ∀ (f : mv_polynomial n k),
    (to_regular_fun_algebra_map : mv_polynomial n k →ₐ[k] regular_fun W) f = 0 → Φ f = 0,
  { intros f hf,
    apply hI,
    intros x hx,
    show (mv_polynomial.to_regular_fun_algebra_map :
      mv_polynomial n k →ₐ[k] regular_fun W) f ⟨x, hx⟩ = 0,
    rw hf,
    refl
  },
  existsi
    (alg_hom.quot.lift mv_polynomial.to_regular_fun_algebra_map to_regular_fun.surjective Φ hfΦ :
    regular_fun W →ₐ[k] regular_fun V),
  intros v g,
  cases to_regular_fun.surjective g with G hG,
  rw ←hG,
  convert hΦ v G,
  apply congr_fun _ v,
  dsimp,
  apply congr_arg,
  refine alg_hom.quot.thm' _ _ Φ _ G,
end

/-- A `morphism` between affine algebraic sets V ⊆ 𝔸ᵐ and W ⊆ 𝔸ⁿ, often called a regular map,
is a pair: a function φ : V → W, and a proof that there exists a k-algebra homomorphism
φstar : k[W] → k[V] such that g ∘ φ = φstar(g) for all g : k[W]  -/
structure morphism (V : affine_algebraic_set k m) (W : affine_algebraic_set k n) :=
(to_fun : (V : subset_of 𝔸ᵐ) → (W : subset_of 𝔸ⁿ))
(is_morphism' :
  ∃ φstar : regular_fun W →ₐ[k] regular_fun V, ∀ (v : (V : subset_of 𝔸ᵐ)) (g : regular_fun W),
    g (to_fun v) = (φstar g) v)

-- notation
infixr ` →ᵣ `:25 := morphism

namespace morphism

instance : has_coe_to_fun (V →ᵣ W) :=
{ F := _,
  coe := morphism.to_fun }

-- best attempt at prettiness so far
lemma is_morphism (φ : V →ᵣ W) : ∃ (φstar : k[W] →ₐ[k] k[V]), ∀ (v : (V : subset_of 𝔸ᵐ))
  (g : k[W]), g (φ v) = φstar g v := φ.is_morphism'

-- lemma some_spec (φ : V →ᵣ W) (x : (V : subset_of 𝔸ᵐ)) (t : n) :
--   classical.some (φ.is_algebraic t) x = (φ x).1 t:=
-- begin
--   cases x,
--   exact (classical.some_spec (φ.is_algebraic t) _ _).symm,
-- end

-- lemma some_spec' (φ : V →ᵣ W) (x : (V : subset_of 𝔸ᵐ)) :
-- (λ (t : n), classical.some (φ.is_algebraic t) x) = (λ (t : n), (φ x).1 t) :=
-- by ext t; apply some_spec φ x t

/-- A regular map between varieties gives a ring map on regular functions. -/
noncomputable def comap (φ : V →ᵣ W) : k[W] →ₐ[k] k[V] :=
{ to_fun := λ f,
  { to_fun := λ x, f (φ x),
    is_regular' := begin
    unfold is_regular,
      cases φ.is_morphism with Φ HΦ,
      cases to_regular_fun.surjective (Φ f) with G hG,
      use G,
      intro x,
      rw [HΦ x f, ←hG],
      refl,
    end
  },
  map_one' := rfl,
  map_mul' := λ f g, rfl,
  map_zero' := rfl,
  map_add' := λ f g, rfl,
  commutes' := λ r, begin
    ext x,
    convert (show r = r, from rfl),
    { refine eval_C r},
    { refine eval_C r},
  end
}

lemma comap_def (φ : V →ᵣ W) (f : k[W]) (v : (V : subset_of 𝔸ᵐ)) :
  φ.comap f v = f (φ v) := rfl

def id (V : affine_algebraic_set k m) : V →ᵣ V :=
{ to_fun := id,
  is_morphism' := ⟨alg_hom.id k _, λ _ _, rfl⟩}

def comp (φ : W →ᵣ Y) (ψ : V →ᵣ W) : V →ᵣ Y :=
{ to_fun := λ u, φ (ψ u),
  is_morphism' := ⟨alg_hom.comp ψ.comap φ.comap, begin
    intros v f,
    rw ←comap_def,
    rw ←comap_def,
    refl,
  end⟩
}

end morphism

end affine_algebraic_set


--- Will clean up these imports
import tactic
import analysis.calculus.iterated_deriv
import topology.continuous_function.polynomial
import topology.separation
import analysis.convex.topology
import topology.path_connected
import analysis.complex.basic
import analysis.calculus.tangent_cone
import analysis.normed_space.units
import analysis.asymptotics.asymptotic_equivalent
import analysis.analytic.basic
import geometry.manifold.algebra.smooth_functions
import linear_algebra.finite_dimensional
import analysis.normed_space.inner_product
import topology.metric_space.basic
import analysis.calculus.formal_multilinear_series
import complex_analysis_prep
import riemann_surfaces

open set complex classical filter asymptotics continuous_linear_map set metric is_open differentiable
open_locale topological_space classical nnreal asymptotics filter ennreal unit_interval

noncomputable theory

def uhalf_plane : set ℂ := {z : ℂ | z.im > 0}

localized "notation `ℍ` := uhalf_plane" in uhalf_plane

section upper_half_plane

@[simp] lemma uhalf_plane.is_open : is_open ℍ :=
begin
  have : ℍ = complex.im⁻¹' Ioi 0 := set.ext (λ z, iff.intro (λ hz, mem_preimage.mp hz) $ λ hz, hz),
  exact is_open.preimage complex.continuous_im is_open_Ioi,
end

@[simp] lemma uhalf_plane.nonempty : set.nonempty ℍ :=
begin
  rw set.nonempty_def,
  use complex.I,
   --- Very bad proof here
  have : complex.I.im > 0 :=  by rw complex.I_im; exact zero_lt_one,
  exact this,
end

@[simp] lemma uhalf_plane.convex : convex ℍ :=
begin
  rw convex_iff_forall_pos,
  intros x y hx hy a b ha hb hab,
  simp,
  exact calc (↑a * x + ↑b * y).im = (↑a * x).im + (↑b * y).im : by simp
    ... = a * x.im + b * y.im : by repeat {rw of_real_mul_im}
    ... > 0 + b * y.im : add_lt_add_of_lt_of_le (mul_pos ha hx) $ le_refl $ b * y.im
    ... > 0 + 0 : add_lt_add_of_le_of_lt (le_refl 0) $ mul_pos hb hy
    ... = 0 : by ring,
end

lemma uhalf_plane.is_path_connected : is_path_connected ℍ :=
convex.is_path_connected uhalf_plane.convex uhalf_plane.nonempty

@[simp] lemma uhalf_plane.is_connected : is_connected ℍ := (is_open.is_connected_iff_is_path_connected uhalf_plane.is_open).mp uhalf_plane.is_path_connected

instance uhalf_plane_connected : connected_space ℍ := is_connected_iff_connected_space.mp uhalf_plane.is_connected

instance uhalf_plane_charted : charted_space ℂ ℍ := topological_space.opens.charted_space ⟨ℍ, uhalf_plane.is_open⟩

instance uhalf_plane_riemann_surface : riemann_surface ℍ := topological_space.opens.riemann_surface ⟨ℍ, uhalf_plane.is_open⟩

--- The ℍ here is the coersed subtype ↥ℍ

end upper_half_plane

section extended_upper_half_plane

inductive uhalf_and_cusps
| of_complex (z : ℂ) (hz : 0 < z.im) : uhalf_and_cusps
| of_rational (r : ℚ) : uhalf_and_cusps
| of_infinity : uhalf_and_cusps

/-
  TODO:
  has_one has_zero has_add has_mul topological_sapce
-/

end extended_upper_half_plane

section ctorus

def clattice {ω : fin 2 → ℂ} (h : linear_independent ℝ ω) : set ℂ :=
{z : ℂ | ∃ (m n : ℤ), z = (m : ℂ) * (ω 0) + (n : ℂ) * (ω 1)}

lemma clattice.add_subgroup {ω : fin 2 → ℂ} (h : linear_independent ℝ ω) :
  add_subgroup ℂ :=
{ carrier := clattice h,
  zero_mem' :=
  --- Very bad proof here. WHY is this proof so slow?
  begin
    have : ∃ (m n : ℤ), (0 : ℂ) = (m : ℂ) * (ω 0) + (n : ℂ) * (ω 1) := begin
      repeat {use 0},
      rw [int.cast_zero, zero_mul, zero_mul, zero_add],
    end,
    exact this,
  end,
  add_mem' :=
  begin
    intros a b ha hb,
    rcases ha with ⟨na, ma, ha'⟩,
    rcases hb with ⟨nb, mb, hb'⟩,
    use (na + nb),
    use (ma + mb),
    exact calc a + b = ↑na * ω 0 + ↑ma * ω 1 + (↑nb * ω 0 + ↑mb * ω 1) : by rw [ha', hb']
      ... = (↑na + ↑nb) * ω 0 + (↑ma + ↑mb) * ω 1 : by ring
      ... = ↑(na + nb) * ω 0 + ↑(ma + mb) * ω 1 : by repeat {rw ← int.cast_add},
  end,
  neg_mem' :=
  begin
    intros z hz,
    rcases hz with ⟨n, m, hz'⟩,
    use (-n),
    use (-m),
    rw [hz', neg_add],
    simp only [int.cast_neg, neg_mul_eq_neg_mul],
  end }

def ctorus {ω : fin 2 → ℂ} (h : linear_independent ℝ ω) : Type* :=
quotient_add_group.quotient (clattice.add_subgroup h)

instance {ω : fin 2 → ℂ} (h : linear_independent ℝ ω) : topological_space (ctorus h) :=
quotient_add_group.quotient.topological_space _

/-
TODO: riemann_surface ctorus
-/

end ctorus


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Heather Macbeth
-/
import topology.algebra.ordered.basic
import topology.algebra.ordered.left_right

/-!
# Continuity of monotone functions

In this file we prove the following fact: if `f` is a monotone function on a neighborhood of `a`
and the image of this neighborhood is a neighborhood of `f a`, then `f` is continuous at `a`, see
`continuous_at_of_monotone_on_of_image_mem_nhds`, as well as several similar facts.

We also prove that an `order_iso` is continuous.

## Tags

continuous, monotone
-/

open set filter
open_locale topological_space

section linear_order
variables {α β : Type*} [linear_order α] [topological_space α] [order_topology α]
variables [linear_order β] [topological_space β] [order_topology β]

/-- If `f` is a function strictly monotone on a right neighborhood of `a` and the
image of this neighborhood under `f` meets every interval `(f a, b]`, `b > f a`, then `f` is
continuous at `a` from the right.

The assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b` is required because otherwise the
function `f : ℝ → ℝ` given by `f x = if x ≤ 0 then x else x + 1` would be a counter-example at
`a = 0`. -/
lemma strict_mono_on.continuous_at_right_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Ici a] a)
  (hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b) :
  continuous_within_at f (Ici a) a :=
begin
  have ha : a ∈ Ici a := left_mem_Ici,
  have has : a ∈ s := mem_of_mem_nhds_within ha hs,
  refine tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩,
  { filter_upwards [hs, self_mem_nhds_within],
    intros x hxs hxa,
    exact hb.trans_le ((h_mono.le_iff_le has hxs).2 hxa) },
  { rcases hfs b hb with ⟨c, hcs, hac, hcb⟩,
    rw [h_mono.lt_iff_lt has hcs] at hac,
    filter_upwards [hs, Ico_mem_nhds_within_Ici (left_mem_Ico.2 hac)],
    rintros x hx ⟨hax, hxc⟩,
    exact ((h_mono.lt_iff_lt hx hcs).2 hxc).trans_le hcb }
end

/-- If `f` is a monotone function on a right neighborhood of `a` and the image of this neighborhood
under `f` meets every interval `(f a, b)`, `b > f a`, then `f` is continuous at `a` from the right.

The assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b` cannot be replaced by the weaker
assumption `hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b` we use for strictly monotone functions
because otherwise the function `ceil : ℝ → ℤ` would be a counter-example at `a = 0`. -/
lemma continuous_at_right_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : monotone_on f s) (hs : s ∈ 𝓝[Ici a] a)
  (hfs : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b) :
  continuous_within_at f (Ici a) a :=
begin
  have ha : a ∈ Ici a := left_mem_Ici,
  have has : a ∈ s := mem_of_mem_nhds_within ha hs,
  refine tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩,
  { filter_upwards [hs, self_mem_nhds_within],
    intros x hxs hxa,
    exact hb.trans_le (h_mono has hxs hxa) },
  { rcases hfs b hb with ⟨c, hcs, hac, hcb⟩,
    have : a < c, from not_le.1 (λ h, hac.not_le $ h_mono hcs has h),
    filter_upwards [hs, Ico_mem_nhds_within_Ici (left_mem_Ico.2 this)],
    rintros x hx ⟨hax, hxc⟩,
    exact (h_mono hx hcs hxc.le).trans_lt hcb }
end

/-- If a function `f` with a densely ordered codomain is monotone on a right neighborhood of `a` and
the closure of the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f`
is continuous at `a` from the right. -/
lemma continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : monotone_on f s)
  (hs : s ∈ 𝓝[Ici a] a) (hfs : closure (f '' s) ∈ 𝓝[Ici (f a)] (f a)) :
  continuous_within_at f (Ici a) a :=
begin
  refine continuous_at_right_of_monotone_on_of_exists_between h_mono hs (λ b hb, _),
  rcases (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hb).1 hfs with ⟨b', ⟨hab', hbb'⟩, hb'⟩,
  rcases exists_between hab' with ⟨c', hc'⟩,
  rcases mem_closure_iff.1 (hb' ⟨hc'.1.le, hc'.2⟩) (Ioo (f a) b') is_open_Ioo hc'
    with ⟨_, hc, ⟨c, hcs, rfl⟩⟩,
  exact ⟨c, hcs, hc.1, hc.2.trans_le hbb'⟩
end

/-- If a function `f` with a densely ordered codomain is monotone on a right neighborhood of `a` and
the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f` is continuous at
`a` from the right. -/
lemma continuous_at_right_of_monotone_on_of_image_mem_nhds_within [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝[Ici a] a)
  (hfs : f '' s ∈ 𝓝[Ici (f a)] (f a)) :
  continuous_within_at f (Ici a) a :=
continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within h_mono hs $
  mem_of_superset hfs subset_closure

/-- If a function `f` with a densely ordered codomain is strictly monotone on a right neighborhood
of `a` and the closure of the image of this neighborhood under `f` is a right neighborhood of `f a`,
then `f` is continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Ici a] a)
  (hfs : closure (f '' s) ∈ 𝓝[Ici (f a)] (f a)) :
  continuous_within_at f (Ici a) a :=
continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within
  (λ x hx y hy, (h_mono.le_iff_le hx hy).2) hs hfs

/-- If a function `f` with a densely ordered codomain is strictly monotone on a right neighborhood
of `a` and the image of this neighborhood under `f` is a right neighborhood of `f a`, then `f` is
continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Ici a] a)
  (hfs : f '' s ∈ 𝓝[Ici (f a)] (f a)) :
  continuous_within_at f (Ici a) a :=
h_mono.continuous_at_right_of_closure_image_mem_nhds_within hs
  (mem_of_superset hfs subset_closure)

/-- If a function `f` is strictly monotone on a right neighborhood of `a` and the image of this
neighborhood under `f` includes `Ioi (f a)`, then `f` is continuous at `a` from the right. -/
lemma strict_mono_on.continuous_at_right_of_surj_on {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Ici a] a) (hfs : surj_on f s (Ioi (f a))) :
  continuous_within_at f (Ici a) a :=
h_mono.continuous_at_right_of_exists_between hs $ λ b hb, let ⟨c, hcs, hcb⟩ := hfs hb in
⟨c, hcs, hcb.symm ▸ hb, hcb.le⟩

/-- If `f` is a strictly monotone function on a left neighborhood of `a` and the image of this
neighborhood under `f` meets every interval `[b, f a)`, `b < f a`, then `f` is continuous at `a`
from the left.

The assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)` is required because otherwise the
function `f : ℝ → ℝ` given by `f x = if x < 0 then x else x + 1` would be a counter-example at
`a = 0`. -/
lemma strict_mono_on.continuous_at_left_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Iic a] a)
  (hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_exists_between hs $
  λ b hb, let ⟨c, hcs, hcb, hca⟩ := hfs b hb in ⟨c, hcs, hca, hcb⟩

/-- If `f` is a monotone function on a left neighborhood of `a` and the image of this neighborhood
under `f` meets every interval `(b, f a)`, `b < f a`, then `f` is continuous at `a` from the left.

The assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)` cannot be replaced by the weaker
assumption `hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)` we use for strictly monotone functions
because otherwise the function `floor : ℝ → ℤ` would be a counter-example at `a = 0`. -/
lemma continuous_at_left_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (hf : monotone_on f s) (hs : s ∈ 𝓝[Iic a] a)
  (hfs : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)) :
  continuous_within_at f (Iic a) a :=
@continuous_at_right_of_monotone_on_of_exists_between (order_dual α) (order_dual β) _ _ _ _ _ _
  f s a hf.dual hs $
  λ b hb, let ⟨c, hcs, hcb, hca⟩ := hfs b hb in ⟨c, hcs, hca, hcb⟩

/-- If a function `f` with a densely ordered codomain is monotone on a left neighborhood of `a` and
the closure of the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is
continuous at `a` from the left -/
lemma continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (hf : monotone_on f s)
  (hs : s ∈ 𝓝[Iic a] a) (hfs : closure (f '' s) ∈ 𝓝[Iic (f a)] (f a)) :
  continuous_within_at f (Iic a) a :=
@continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within (order_dual α) (order_dual β)
  _ _ _ _ _ _ _ f s a hf.dual hs hfs

/-- If a function `f` with a densely ordered codomain is monotone on a left neighborhood of `a` and
the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is continuous at
`a` from the left. -/
lemma continuous_at_left_of_monotone_on_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : monotone_on f s)
  (hs : s ∈ 𝓝[Iic a] a) (hfs : f '' s ∈ 𝓝[Iic (f a)] (f a)) :
  continuous_within_at f (Iic a) a :=
continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within h_mono hs
  (mem_of_superset hfs subset_closure)

/-- If a function `f` with a densely ordered codomain is strictly monotone on a left neighborhood of
`a` and the closure of the image of this neighborhood under `f` is a left neighborhood of `f a`,
then `f` is continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_closure_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Iic a] a)
  (hfs : closure (f '' s) ∈ 𝓝[Iic (f a)] (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_closure_image_mem_nhds_within hs hfs

/-- If a function `f` with a densely ordered codomain is strictly monotone on a left neighborhood of
`a` and the image of this neighborhood under `f` is a left neighborhood of `f a`, then `f` is
continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_image_mem_nhds_within [densely_ordered β]
  {f : α → β} {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Iic a] a)
  (hfs : f '' s ∈ 𝓝[Iic (f a)] (f a)) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_image_mem_nhds_within hs hfs

/-- If a function `f` is strictly monotone on a left neighborhood of `a` and the image of this
neighborhood under `f` includes `Iio (f a)`, then `f` is continuous at `a` from the left. -/
lemma strict_mono_on.continuous_at_left_of_surj_on {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝[Iic a] a) (hfs : surj_on f s (Iio (f a))) :
  continuous_within_at f (Iic a) a :=
h_mono.dual.continuous_at_right_of_surj_on hs hfs

/-- If a function `f` is strictly monotone on a neighborhood of `a` and the image of this
neighborhood under `f` meets every interval `[b, f a)`, `b < f a`, and every interval
`(f a, b]`, `b > f a`, then `f` is continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a)
  (hfs_l : ∀ b < f a, ∃ c ∈ s, f c ∈ Ico b (f a)) (hfs_r : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioc (f a) b) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨h_mono.continuous_at_left_of_exists_between (mem_nhds_within_of_mem_nhds hs) hfs_l,
   h_mono.continuous_at_right_of_exists_between (mem_nhds_within_of_mem_nhds hs) hfs_r⟩

/-- If a function `f` with a densely ordered codomain is strictly monotone on a neighborhood of `a`
and the closure of the image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is
continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_closure_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a)
  (hfs : closure (f '' s) ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨h_mono.continuous_at_left_of_closure_image_mem_nhds_within (mem_nhds_within_of_mem_nhds hs)
     (mem_nhds_within_of_mem_nhds hfs),
   h_mono.continuous_at_right_of_closure_image_mem_nhds_within (mem_nhds_within_of_mem_nhds hs)
     (mem_nhds_within_of_mem_nhds hfs)⟩

/-- If a function `f` with a densely ordered codomain is strictly monotone on a neighborhood of `a`
and the image of this set under `f` is a neighborhood of `f a`, then `f` is continuous at `a`. -/
lemma strict_mono_on.continuous_at_of_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : strict_mono_on f s) (hs : s ∈ 𝓝 a) (hfs : f '' s ∈ 𝓝 (f a)) :
  continuous_at f a :=
h_mono.continuous_at_of_closure_image_mem_nhds hs (mem_of_superset hfs subset_closure)

/-- If `f` is a monotone function on a neighborhood of `a` and the image of this neighborhood under
`f` meets every interval `(b, f a)`, `b < f a`, and every interval `(f a, b)`, `b > f a`, then `f`
is continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_exists_between {f : α → β} {s : set α} {a : α}
  (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs_l : ∀ b < f a, ∃ c ∈ s, f c ∈ Ioo b (f a)) (hfs_r : ∀ b > f a, ∃ c ∈ s, f c ∈ Ioo (f a) b) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨continuous_at_left_of_monotone_on_of_exists_between h_mono
     (mem_nhds_within_of_mem_nhds hs) hfs_l,
   continuous_at_right_of_monotone_on_of_exists_between h_mono
     (mem_nhds_within_of_mem_nhds hs) hfs_r⟩

/-- If a function `f` with a densely ordered codomain is monotone on a neighborhood of `a` and the
closure of the image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is
continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_closure_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs : closure (f '' s) ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_iff_continuous_left_right.2
  ⟨continuous_at_left_of_monotone_on_of_closure_image_mem_nhds_within h_mono
     (mem_nhds_within_of_mem_nhds hs) (mem_nhds_within_of_mem_nhds hfs),
   continuous_at_right_of_monotone_on_of_closure_image_mem_nhds_within h_mono
     (mem_nhds_within_of_mem_nhds hs) (mem_nhds_within_of_mem_nhds hfs)⟩

/-- If a function `f` with a densely ordered codomain is monotone on a neighborhood of `a` and the
image of this neighborhood under `f` is a neighborhood of `f a`, then `f` is continuous at `a`. -/
lemma continuous_at_of_monotone_on_of_image_mem_nhds [densely_ordered β] {f : α → β}
  {s : set α} {a : α} (h_mono : monotone_on f s) (hs : s ∈ 𝓝 a)
  (hfs : f '' s ∈ 𝓝 (f a)) :
  continuous_at f a :=
continuous_at_of_monotone_on_of_closure_image_mem_nhds h_mono hs
  (mem_of_superset hfs subset_closure)

/-- A monotone function with densely ordered codomain and a dense range is continuous. -/
lemma monotone.continuous_of_dense_range [densely_ordered β] {f : α → β}
  (h_mono : monotone f) (h_dense : dense_range f) :
  continuous f :=
continuous_iff_continuous_at.mpr $ λ a,
  continuous_at_of_monotone_on_of_closure_image_mem_nhds (λ x hx y hy hxy, h_mono hxy)
    univ_mem $ by simp only [image_univ, h_dense.closure_eq, univ_mem]

/-- A monotone surjective function with a densely ordered codomain is continuous. -/
lemma monotone.continuous_of_surjective [densely_ordered β] {f : α → β} (h_mono : monotone f)
  (h_surj : function.surjective f) :
  continuous f :=
h_mono.continuous_of_dense_range h_surj.dense_range

end linear_order

/-!
### Continuity of order isomorphisms

In this section we prove that an `order_iso` is continuous, hence it is a `homeomorph`. We prove
this for an `order_iso` between to partial orders with order topology.
-/

namespace order_iso

variables {α β : Type*} [partial_order α] [partial_order β] [topological_space α]
  [topological_space β] [order_topology α] [order_topology β]

protected lemma continuous (e : α ≃o β) : continuous e :=
begin
  rw [‹order_topology β›.topology_eq_generate_intervals],
  refine continuous_generated_from (λ s hs, _),
  rcases hs with ⟨a, rfl|rfl⟩,
  { rw e.preimage_Ioi, apply is_open_lt' },
  { rw e.preimage_Iio, apply is_open_gt' }
end

/-- An order isomorphism between two linear order `order_topology` spaces is a homeomorphism. -/
def to_homeomorph (e : α ≃o β) : α ≃ₜ β :=
{ continuous_to_fun := e.continuous,
  continuous_inv_fun := e.symm.continuous,
  .. e }

@[simp] lemma coe_to_homeomorph (e : α ≃o β) : ⇑e.to_homeomorph = e := rfl
@[simp] lemma coe_to_homeomorph_symm (e : α ≃o β) : ⇑e.to_homeomorph.symm = e.symm := rfl

end order_iso


/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison
-/
import topology.instances.real
import topology.algebra.field
import data.set.intervals.proj_Icc
import data.set.intervals.instances

/-!
# The unit interval, as a topological space

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

Use `open_locale unit_interval` to turn on the notation `I := set.Icc (0 : ℝ) (1 : ℝ)`.

We provide basic instances, as well as a custom tactic for discharging
`0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` when `x : I`.

-/

noncomputable theory
open_locale classical topology filter
open set int set.Icc

/-! ### The unit interval -/

/-- The unit interval `[0,1]` in ℝ. -/
abbreviation unit_interval : set ℝ := set.Icc 0 1

localized "notation (name := unit_interval) `I` := unit_interval" in unit_interval

namespace unit_interval

lemma zero_mem : (0 : ℝ) ∈ I := ⟨le_rfl, zero_le_one⟩

lemma one_mem : (1 : ℝ) ∈ I := ⟨zero_le_one, le_rfl⟩

lemma mul_mem {x y : ℝ} (hx : x ∈ I) (hy : y ∈ I) : x * y ∈ I :=
⟨mul_nonneg hx.1 hy.1, (mul_le_mul hx.2 hy.2 hy.1 zero_le_one).trans_eq $ one_mul 1⟩

lemma div_mem {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) (hxy : x ≤ y) : x / y ∈ I :=
⟨div_nonneg hx hy, div_le_one_of_le hxy hy⟩

lemma fract_mem (x : ℝ) : fract x ∈ I := ⟨fract_nonneg _, (fract_lt_one _).le⟩

lemma mem_iff_one_sub_mem {t : ℝ} : t ∈ I ↔ 1 - t ∈ I :=
begin
  rw [mem_Icc, mem_Icc],
  split ; intro ; split ; linarith
end

instance has_zero : has_zero I := ⟨⟨0, zero_mem⟩⟩

instance has_one : has_one I := ⟨⟨1, by split ; norm_num⟩⟩

lemma coe_ne_zero {x : I} : (x : ℝ) ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr coe_eq_zero

lemma coe_ne_one {x : I} : (x : ℝ) ≠ 1 ↔ x ≠ 1 :=
not_iff_not.mpr coe_eq_one

instance : nonempty I := ⟨0⟩

instance : has_mul I := ⟨λ x y, ⟨x * y, mul_mem x.2 y.2⟩⟩

-- todo: we could set up a `linear_ordered_comm_monoid_with_zero I` instance

lemma mul_le_left {x y : I} : x * y ≤ x :=
subtype.coe_le_coe.mp $ (mul_le_mul_of_nonneg_left y.2.2 x.2.1).trans_eq $ mul_one x

lemma mul_le_right {x y : I} : x * y ≤ y :=
subtype.coe_le_coe.mp $ (mul_le_mul_of_nonneg_right x.2.2 y.2.1).trans_eq $ one_mul y

/-- Unit interval central symmetry. -/
def symm : I → I := λ t, ⟨1 - t, mem_iff_one_sub_mem.mp t.prop⟩

localized "notation (name := unit_interval.symm) `σ` := unit_interval.symm" in unit_interval

@[simp] lemma symm_zero : σ 0 = 1 :=
subtype.ext $ by simp [symm]

@[simp] lemma symm_one : σ 1 = 0 :=
subtype.ext $ by simp [symm]

@[simp] lemma symm_symm (x : I) : σ (σ x) = x :=
subtype.ext $ by simp [symm]

@[simp] lemma coe_symm_eq (x : I) : (σ x : ℝ) = 1 - x := rfl

@[continuity]
lemma continuous_symm : continuous σ :=
by continuity!

instance : connected_space I :=
subtype.connected_space ⟨nonempty_Icc.mpr zero_le_one, is_preconnected_Icc⟩

/-- Verify there is an instance for `compact_space I`. -/
example : compact_space I := by apply_instance

lemma nonneg (x : I) : 0 ≤ (x : ℝ) := x.2.1
lemma one_minus_nonneg (x : I) : 0 ≤ 1 - (x : ℝ) := by simpa using x.2.2
lemma le_one (x : I) : (x : ℝ) ≤ 1 := x.2.2
lemma one_minus_le_one (x : I) : 1 - (x : ℝ) ≤ 1 := by simpa using x.2.1
lemma add_pos {t : I} {x : ℝ} (hx : 0 < x) : 0 < (x + t : ℝ) :=
add_pos_of_pos_of_nonneg hx $ nonneg _

/-- like `unit_interval.nonneg`, but with the inequality in `I`. -/
lemma nonneg' {t : I} : 0 ≤ t := t.2.1
/-- like `unit_interval.le_one`, but with the inequality in `I`. -/
lemma le_one' {t : I} : t ≤ 1 := t.2.2

lemma mul_pos_mem_iff {a t : ℝ} (ha : 0 < a) : a * t ∈ I ↔ t ∈ set.Icc (0 : ℝ) (1/a) :=
begin
  split; rintros ⟨h₁, h₂⟩; split,
  { exact nonneg_of_mul_nonneg_right h₁ ha },
  { rwa [le_div_iff ha, mul_comm] },
  { exact mul_nonneg ha.le h₁ },
  { rwa [le_div_iff ha, mul_comm] at h₂ }
end

lemma two_mul_sub_one_mem_iff {t : ℝ} : 2 * t - 1 ∈ I ↔ t ∈ set.Icc (1/2 : ℝ) 1 :=
by split; rintros ⟨h₁, h₂⟩; split; linarith

end unit_interval

@[simp] lemma proj_Icc_eq_zero {x : ℝ} : proj_Icc (0 : ℝ) 1 zero_le_one x = 0 ↔ x ≤ 0 :=
proj_Icc_eq_left zero_lt_one

@[simp] lemma proj_Icc_eq_one {x : ℝ} : proj_Icc (0 : ℝ) 1 zero_le_one x = 1 ↔ 1 ≤ x :=
proj_Icc_eq_right zero_lt_one

namespace tactic.interactive

/-- A tactic that solves `0 ≤ ↑x`, `0 ≤ 1 - ↑x`, `↑x ≤ 1`, and `1 - ↑x ≤ 1` for `x : I`. -/
meta def unit_interval : tactic unit :=
`[apply unit_interval.nonneg] <|> `[apply unit_interval.one_minus_nonneg] <|>
`[apply unit_interval.le_one] <|> `[apply unit_interval.one_minus_le_one]

end tactic.interactive

section
variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [topological_ring 𝕜]

/--
The image of `[0,1]` under the homeomorphism `λ x, a * x + b` is `[b, a+b]`.
-/
-- We only need the ordering on `𝕜` here to avoid talking about flipping the interval over.
-- At the end of the day I only care about `ℝ`, so I'm hesitant to put work into generalizing.
lemma affine_homeomorph_image_I (a b : 𝕜) (h : 0 < a) :
  affine_homeomorph a b h.ne.symm '' set.Icc 0 1 = set.Icc b (a + b) :=
by simp [h]

/--
The affine homeomorphism from a nontrivial interval `[a,b]` to `[0,1]`.
-/
def Icc_homeo_I (a b : 𝕜) (h : a < b) : set.Icc a b ≃ₜ set.Icc (0 : 𝕜) (1 : 𝕜) :=
begin
  let e := homeomorph.image (affine_homeomorph (b-a) a (sub_pos.mpr h).ne.symm) (set.Icc 0 1),
  refine (e.trans _).symm,
  apply homeomorph.set_congr,
  simp [sub_pos.mpr h],
end

@[simp] lemma Icc_homeo_I_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc a b) :
  ((Icc_homeo_I a b h) x : 𝕜) = (x - a) / (b - a) :=
rfl

@[simp] lemma Icc_homeo_I_symm_apply_coe (a b : 𝕜) (h : a < b) (x : set.Icc (0 : 𝕜) (1 : 𝕜)) :
  ((Icc_homeo_I a b h).symm x : 𝕜) = (b - a) * x + a :=
rfl

end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import data.int.basic
import data.list.range

/-!
# Intervals in ℤ

This file defines integer ranges. `range m n` is the set of integers greater than `m` and strictly
less than `n`.

## Note

This could be unified with `data.list.intervals`. See the TODOs there.
-/

namespace int

local attribute [semireducible] int.nonneg

/-- List enumerating `[m, n)`. This is the ℤ variant of `list.Ico`. -/
def range (m n : ℤ) : list ℤ :=
(list.range (to_nat (n-m))).map $ λ r, m+r

theorem mem_range_iff {m n r : ℤ} : r ∈ range m n ↔ m ≤ r ∧ r < n :=
⟨λ H, let ⟨s, h1, h2⟩ := list.mem_map.1 H in h2 ▸
  ⟨le_add_of_nonneg_right trivial,
  add_lt_of_lt_sub_left $ match n-m, h1 with
    | (k:ℕ), h1 := by rwa [list.mem_range, to_nat_coe_nat, ← coe_nat_lt] at h1
    end⟩,
λ ⟨h1, h2⟩, list.mem_map.2 ⟨to_nat (r-m),
  list.mem_range.2 $ by rw [← coe_nat_lt, to_nat_of_nonneg (sub_nonneg_of_le h1),
      to_nat_of_nonneg (sub_nonneg_of_le (le_of_lt (lt_of_le_of_lt h1 h2)))];
    exact sub_lt_sub_right h2 _,
  show m + _ = _, by rw [to_nat_of_nonneg (sub_nonneg_of_le h1), add_sub_cancel'_right]⟩⟩

instance decidable_le_lt (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m ≤ r → r < n → P r) :=
decidable_of_iff (∀ r ∈ range m n, P r) $ by simp only [mem_range_iff, and_imp]

instance decidable_le_le (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m ≤ r → r ≤ n → P r) :=
decidable_of_iff (∀ r ∈ range m (n+1), P r) $ by simp only [mem_range_iff, and_imp, lt_add_one_iff]

instance decidable_lt_lt (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m < r → r < n → P r) :=
int.decidable_le_lt P _ _

instance decidable_lt_le (P : int → Prop) [decidable_pred P] (m n : ℤ) :
  decidable (∀ r, m < r → r ≤ n → P r) :=
int.decidable_le_le P _ _

end int