-- Union_con_su_diferencia.lean
-- Unión con su diferencia
-- José A. Alonso Jiménez
-- Sevilla, 27 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (s \ t) ∪ t = s ∪ t
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t : set α

-- 1ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
begin
  ext x,
  split,
  { intro hx,
    cases hx with xst xt,
    { left,
      exact xst.1, },
    { right,
      exact xt }},
  { by_cases h : x ∈ t,
    { intro _,
      right,
      exact h },
    { intro hx,
      cases hx with xs xt,
      { left,
        split,
        { exact xs, },
        { exact h, }},
      { right,
        exact xt, }}},
end

-- 2ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
begin
  ext x,
  split,
  { rintros (⟨xs, nxt⟩ | xt),
    { left,
      exact xs},
    { right,
      exact xt }},
  { by_cases h : x ∈ t,
    { intro _,
      right,
      exact h },
    { rintros (xs | xt),
      { left,
        use [xs, h] },
      { right,
        use xt }}},
end

-- 3ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
begin
  rw ext_iff,
  intro,
  rw iff_def,
  finish,
end

-- 4ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
by finish [ext_iff, iff_def]

-- 5ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
diff_union_self

-- 6ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
begin
  ext,
  simp,
end

-- 7ª definición
-- =============

example : (s \ t) ∪ t = s ∪ t :=
by simp


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

! This file was ported from Lean 3 source module topology.category.Profinite.cofiltered_limit
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Category.Profinite.Basic
import Mathbin.Topology.LocallyConstant.Basic
import Mathbin.Topology.DiscreteQuotient

/-!
# Cofiltered limits of profinite sets.

This file contains some theorems about cofiltered limits of profinite sets.

## Main Results

- `exists_clopen_of_cofiltered` shows that any clopen set in a cofiltered limit of profinite
  sets is the pullback of a clopen set from one of the factors in the limit.
- `exists_locally_constant` shows that any locally constant function from a cofiltered limit
  of profinite sets factors through one of the components.
-/

namespace Profinite

open Classical

open CategoryTheory

open CategoryTheory.Limits

universe u

variable {J : Type u} [SmallCategory J] [IsCofiltered J] {F : J ⥤ Profinite.{u}} (C : Cone F)
  (hC : IsLimit C)

include hC

/-- If `X` is a cofiltered limit of profinite sets, then any clopen subset of `X` arises from
a clopen set in one of the terms in the limit.
-/
theorem exists_clopen_of_cofiltered {U : Set C.pt} (hU : IsClopen U) :
    ∃ (j : J)(V : Set (F.obj j))(hV : IsClopen V), U = C.π.app j ⁻¹' V :=
  by
  -- First, we have the topological basis of the cofiltered limit obtained by pulling back
  -- clopen sets from the factors in the limit. By continuity, all such sets are again clopen.
  have hB :=
    TopCat.isTopologicalBasis_cofiltered_limit.{u} (F ⋙ Profinite.toTop)
      (Profinite.to_Top.map_cone C) (is_limit_of_preserves _ hC) (fun j => { W | IsClopen W }) _
      (fun i => isClopen_univ) (fun i U1 U2 hU1 hU2 => hU1.inter hU2) _
  rotate_left
  · intro i
    change TopologicalSpace.IsTopologicalBasis { W : Set (F.obj i) | IsClopen W }
    apply isTopologicalBasis_clopen
  · rintro i j f V (hV : IsClopen _)
    refine' ⟨hV.1.preimage _, hV.2.preimage _⟩ <;> continuity
  -- Using this, since `U` is open, we can write `U` as a union of clopen sets all of which
  -- are preimages of clopens from the factors in the limit.
  obtain ⟨S, hS, h⟩ := hB.open_eq_sUnion hU.1
  clear hB
  let j : S → J := fun s => (hS s.2).some
  let V : ∀ s : S, Set (F.obj (j s)) := fun s => (hS s.2).choose_spec.some
  have hV : ∀ s : S, IsClopen (V s) ∧ s.1 = C.π.app (j s) ⁻¹' V s := fun s =>
    (hS s.2).choose_spec.choose_spec
  -- Since `U` is also closed, hence compact, it is covered by finitely many of the
  -- clopens constructed in the previous step.
  have := hU.2.IsCompact.elim_finite_subcover (fun s : S => C.π.app (j s) ⁻¹' V s) _ _
  rotate_left
  · intro s
    refine' (hV s).1.1.preimage _
    continuity
  · dsimp only
    rw [h]
    rintro x ⟨T, hT, hx⟩
    refine' ⟨_, ⟨⟨T, hT⟩, rfl⟩, _⟩
    dsimp only
    rwa [← (hV ⟨T, hT⟩).2]
  -- We thus obtain a finite set `G : finset J` and a clopen set of `F.obj j` for each
  -- `j ∈ G` such that `U` is the union of the preimages of these clopen sets.
  obtain ⟨G, hG⟩ := this
  -- Since `J` is cofiltered, we can find a single `j0` dominating all the `j ∈ G`.
  -- Pulling back all of the sets from the previous step to `F.obj j0` and taking a union,
  -- we obtain a clopen set in `F.obj j0` which works.
  obtain ⟨j0, hj0⟩ := is_cofiltered.inf_objs_exists (G.image j)
  let f : ∀ (s : S) (hs : s ∈ G), j0 ⟶ j s := fun s hs =>
    (hj0 (finset.mem_image.mpr ⟨s, hs, rfl⟩)).some
  let W : S → Set (F.obj j0) := fun s => if hs : s ∈ G then F.map (f s hs) ⁻¹' V s else Set.univ
  -- Conclude, using the `j0` and the clopen set of `F.obj j0` obtained above.
  refine' ⟨j0, ⋃ (s : S) (hs : s ∈ G), W s, _, _⟩
  · apply isClopen_bunionᵢ_finset
    intro s hs
    dsimp only [W]
    rw [dif_pos hs]
    refine' ⟨(hV s).1.1.preimage _, (hV s).1.2.preimage _⟩ <;> continuity
  · ext x
    constructor
    · intro hx
      simp_rw [Set.preimage_unionᵢ, Set.mem_unionᵢ]
      obtain ⟨_, ⟨s, rfl⟩, _, ⟨hs, rfl⟩, hh⟩ := hG hx
      refine' ⟨s, hs, _⟩
      dsimp only [W] at hh⊢
      rwa [dif_pos hs, ← Set.preimage_comp, ← Profinite.coe_comp, C.w]
    · intro hx
      simp_rw [Set.preimage_unionᵢ, Set.mem_unionᵢ] at hx
      obtain ⟨s, hs, hx⟩ := hx
      rw [h]
      refine' ⟨s.1, s.2, _⟩
      rw [(hV s).2]
      dsimp only [W] at hx
      rwa [dif_pos hs, ← Set.preimage_comp, ← Profinite.coe_comp, C.w] at hx
#align Profinite.exists_clopen_of_cofiltered Profinite.exists_clopen_of_cofiltered

theorem exists_locallyConstant_fin_two (f : LocallyConstant C.pt (Fin 2)) :
    ∃ (j : J)(g : LocallyConstant (F.obj j) (Fin 2)), f = g.comap (C.π.app _) :=
  by
  let U := f ⁻¹' {0}
  have hU : IsClopen U := f.is_locally_constant.is_clopen_fiber _
  obtain ⟨j, V, hV, h⟩ := exists_clopen_of_cofiltered C hC hU
  use j, LocallyConstant.ofClopen hV
  apply LocallyConstant.locallyConstant_eq_of_fiber_zero_eq
  rw [LocallyConstant.coe_comap _ _ (C.π.app j).Continuous]
  conv_rhs => rw [Set.preimage_comp]
  rw [LocallyConstant.ofClopen_fiber_zero hV, ← h]
#align Profinite.exists_locally_constant_fin_two Profinite.exists_locallyConstant_fin_two

theorem exists_locallyConstant_finite_aux {α : Type _} [Finite α] (f : LocallyConstant C.pt α) :
    ∃ (j : J)(g : LocallyConstant (F.obj j) (α → Fin 2)),
      (f.map fun a b => if a = b then (0 : Fin 2) else 1) = g.comap (C.π.app _) :=
  by
  cases nonempty_fintype α
  let ι : α → α → Fin 2 := fun x y => if x = y then 0 else 1
  let ff := (f.map ι).flip
  have hff := fun a : α => exists_locally_constant_fin_two _ hC (ff a)
  choose j g h using hff
  let G : Finset J := finset.univ.image j
  obtain ⟨j0, hj0⟩ := is_cofiltered.inf_objs_exists G
  have hj : ∀ a, j a ∈ G := by
    intro a
    simp [G]
  let fs : ∀ a : α, j0 ⟶ j a := fun a => (hj0 (hj a)).some
  let gg : α → LocallyConstant (F.obj j0) (Fin 2) := fun a => (g a).comap (F.map (fs _))
  let ggg := LocallyConstant.unflip gg
  refine' ⟨j0, ggg, _⟩
  have : f.map ι = LocallyConstant.unflip (f.map ι).flip := by simp
  rw [this]
  clear this
  have :
    LocallyConstant.comap (C.π.app j0) ggg =
      LocallyConstant.unflip (LocallyConstant.comap (C.π.app j0) ggg).flip :=
    by simp
  rw [this]
  clear this
  congr 1
  ext1 a
  change ff a = _
  rw [h]
  dsimp [ggg, gg]
  ext1
  repeat'
    rw [LocallyConstant.coe_comap]
    dsimp [LocallyConstant.flip, LocallyConstant.unflip]
  · congr 1
    change _ = (C.π.app j0 ≫ F.map (fs a)) x
    rw [C.w]
  all_goals continuity
#align Profinite.exists_locally_constant_finite_aux Profinite.exists_locallyConstant_finite_aux

theorem exists_locallyConstant_finite_nonempty {α : Type _} [Finite α] [Nonempty α]
    (f : LocallyConstant C.pt α) :
    ∃ (j : J)(g : LocallyConstant (F.obj j) α), f = g.comap (C.π.app _) :=
  by
  inhabit α
  obtain ⟨j, gg, h⟩ := exists_locally_constant_finite_aux _ hC f
  let ι : α → α → Fin 2 := fun a b => if a = b then 0 else 1
  let σ : (α → Fin 2) → α := fun f => if h : ∃ a : α, ι a = f then h.some else Inhabited.default _
  refine' ⟨j, gg.map σ, _⟩
  ext
  rw [LocallyConstant.coe_comap _ _ (C.π.app j).Continuous]
  dsimp [σ]
  have h1 : ι (f x) = gg (C.π.app j x) :=
    by
    change f.map (fun a b => if a = b then (0 : Fin 2) else 1) x = _
    rw [h, LocallyConstant.coe_comap _ _ (C.π.app j).Continuous]
  have h2 : ∃ a : α, ι a = gg (C.π.app j x) := ⟨f x, h1⟩
  rw [dif_pos h2]
  apply_fun ι
  · rw [h2.some_spec]
    exact h1
  · intro a b hh
    apply_fun fun e => e a  at hh
    dsimp [ι] at hh
    rw [if_pos rfl] at hh
    split_ifs  at hh with hh1 hh1
    · exact hh1.symm
    · exact False.elim (bot_ne_top hh)
#align Profinite.exists_locally_constant_finite_nonempty Profinite.exists_locallyConstant_finite_nonempty

/-- Any locally constant function from a cofiltered limit of profinite sets factors through
one of the components. -/
theorem exists_locallyConstant {α : Type _} (f : LocallyConstant C.pt α) :
    ∃ (j : J)(g : LocallyConstant (F.obj j) α), f = g.comap (C.π.app _) :=
  by
  let S := f.discrete_quotient
  let ff : S → α := f.lift
  cases isEmpty_or_nonempty S
  · suffices ∃ j, IsEmpty (F.obj j) by
      refine' this.imp fun j hj => _
      refine' ⟨⟨hj.elim, fun A => _⟩, _⟩
      · convert isOpen_empty
        exact @Set.eq_empty_of_isEmpty _ hj _
      · ext x
        exact hj.elim' (C.π.app j x)
    simp only [← not_nonempty_iff, ← not_forall]
    intro h
    haveI : ∀ j : J, Nonempty ((F ⋙ Profinite.toTop).obj j) := h
    haveI : ∀ j : J, T2Space ((F ⋙ Profinite.toTop).obj j) := fun j =>
      (inferInstance : T2Space (F.obj j))
    haveI : ∀ j : J, CompactSpace ((F ⋙ Profinite.toTop).obj j) := fun j =>
      (inferInstance : CompactSpace (F.obj j))
    have cond := TopCat.nonempty_limitCone_of_compact_t2_cofiltered_system (F ⋙ Profinite.toTop)
    suffices : Nonempty C.X
    exact IsEmpty.false (S.proj this.some)
    let D := Profinite.to_Top.map_cone C
    have hD : is_limit D := is_limit_of_preserves Profinite.toTop hC
    have CD := (hD.cone_point_unique_up_to_iso (TopCat.limitConeIsLimit.{u} _)).inv
    exact cond.map CD
  · let f' : LocallyConstant C.X S := ⟨S.proj, S.proj_is_locally_constant⟩
    obtain ⟨j, g', hj⟩ := exists_locally_constant_finite_nonempty _ hC f'
    refine' ⟨j, ⟨ff ∘ g', g'.is_locally_constant.comp _⟩, _⟩
    ext1 t
    apply_fun fun e => e t  at hj
    rw [LocallyConstant.coe_comap _ _ (C.π.app j).Continuous] at hj⊢
    dsimp at hj⊢
    rw [← hj]
    rfl
#align Profinite.exists_locally_constant Profinite.exists_locallyConstant

end Profinite


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn
-/
import order.bounds.order_iso
import algebra.field.basic
import algebra.order.field.defs
import algebra.group_power.order

/-!
# Lemmas about linear ordered (semi)fields

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

-/

open function order_dual

variables {ι α β : Type*}

section linear_ordered_semifield
variables [linear_ordered_semifield α] {a b c d e : α} {m n : ℤ}

/-- `equiv.mul_left₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_left₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_left ha, ..equiv.mul_left₀ a ha.ne' }

/-- `equiv.mul_right₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_right₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_right ha, ..equiv.mul_right₀ a ha.ne' }

/-!
### Lemmas about pos, nonneg, nonpos, neg
-/

@[simp] lemma inv_pos : 0 < a⁻¹ ↔ 0 < a :=
suffices ∀ a : α, 0 < a → 0 < a⁻¹,
from ⟨λ h, inv_inv a ▸ this _ h, this a⟩,
assume a ha, flip lt_of_mul_lt_mul_left ha.le $ by simp [ne_of_gt ha, zero_lt_one]

alias inv_pos ↔ _ inv_pos_of_pos

@[simp] lemma inv_nonneg : 0 ≤ a⁻¹ ↔ 0 ≤ a :=
by simp only [le_iff_eq_or_lt, inv_pos, zero_eq_inv]

alias inv_nonneg ↔ _ inv_nonneg_of_nonneg

@[simp] lemma inv_lt_zero : a⁻¹ < 0 ↔ a < 0 :=
by simp only [← not_le, inv_nonneg]

@[simp] lemma inv_nonpos : a⁻¹ ≤ 0 ↔ a ≤ 0 :=
by simp only [← not_lt, inv_pos]

lemma one_div_pos : 0 < 1 / a ↔ 0 < a :=
inv_eq_one_div a ▸ inv_pos

lemma one_div_neg : 1 / a < 0 ↔ a < 0 :=
inv_eq_one_div a ▸ inv_lt_zero

lemma one_div_nonneg : 0 ≤ 1 / a ↔ 0 ≤ a :=
inv_eq_one_div a ▸ inv_nonneg

lemma one_div_nonpos : 1 / a ≤ 0 ↔ a ≤ 0 :=
inv_eq_one_div a ▸ inv_nonpos

lemma div_pos (ha : 0 < a) (hb : 0 < b) : 0 < a / b :=
by { rw div_eq_mul_inv, exact mul_pos ha (inv_pos.2 hb) }

lemma div_nonneg (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b :=
by { rw div_eq_mul_inv, exact mul_nonneg ha (inv_nonneg.2 hb) }

lemma div_nonpos_of_nonpos_of_nonneg (ha : a ≤ 0) (hb : 0 ≤ b) : a / b ≤ 0 :=
by { rw div_eq_mul_inv, exact mul_nonpos_of_nonpos_of_nonneg ha (inv_nonneg.2 hb) }

lemma div_nonpos_of_nonneg_of_nonpos (ha : 0 ≤ a) (hb : b ≤ 0) : a / b ≤ 0 :=
by { rw div_eq_mul_inv, exact mul_nonpos_of_nonneg_of_nonpos ha (inv_nonpos.2 hb) }

lemma zpow_nonneg (ha : 0 ≤ a) : ∀ n : ℤ, 0 ≤ a ^ n
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_nonneg ha _ }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_nonneg.2 (pow_nonneg ha _) }

lemma zpow_pos_of_pos (ha : 0 < a) : ∀ n : ℤ, 0 < a ^ n
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_pos ha _ }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_pos.2 (pow_pos ha _) }

/-!
### Relating one division with another term.
-/

lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc).symm ▸ mul_le_mul_of_nonneg_right h hc.le,
  λ h, calc
    a   = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc).symm
    ... ≤ b * (1 / c)     : mul_le_mul_of_nonneg_right h (one_div_pos.2 hc).le
    ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b :=
by rw [mul_comm, le_div_iff hc]

lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b :=
⟨λ h, calc
  a = a / b * b : by rw (div_mul_cancel _ (ne_of_lt hb).symm)
  ... ≤ c * b     : mul_le_mul_of_nonneg_right h hb.le,
  λ h, calc
  a / b = a * (1 / b)     : div_eq_mul_one_div a b
  ... ≤ (c * b) * (1 / b) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hb).le
  ... = (c * b) / b       : (div_eq_mul_one_div (c * b) b).symm
  ... = c                 : by refine (div_eq_iff (ne_of_gt hb)).mpr rfl⟩

lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, div_le_iff hb]

lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ div_le_iff hc

lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b :=
by rw [mul_comm, lt_div_iff hc]

lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c :=
lt_iff_lt_of_le_iff_le (le_div_iff hc)

lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a :=
by rw [mul_comm, div_lt_iff hc]

lemma inv_mul_le_iff (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_le_iff' h,
end

lemma inv_mul_le_iff' (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ c * b :=
by rw [inv_mul_le_iff h, mul_comm]

lemma mul_inv_le_iff (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, inv_mul_le_iff h]

lemma mul_inv_le_iff' (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ c * b :=
by rw [mul_comm, inv_mul_le_iff' h]

lemma div_self_le_one (a : α) : a / a ≤ 1 :=
if h : a = 0 then by simp [h] else by simp [h]

lemma inv_mul_lt_iff (h : 0 < b) : b⁻¹ * a < c ↔ a < b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_lt_iff' h,
end

lemma inv_mul_lt_iff' (h : 0 < b) : b⁻¹ * a < c ↔ a < c * b :=
by rw [inv_mul_lt_iff h, mul_comm]

lemma mul_inv_lt_iff (h : 0 < b) : a * b⁻¹ < c ↔ a < b * c :=
by rw [mul_comm, inv_mul_lt_iff h]

lemma mul_inv_lt_iff' (h : 0 < b) : a * b⁻¹ < c ↔ a < c * b :=
by rw [mul_comm, inv_mul_lt_iff' h]

lemma inv_pos_le_iff_one_le_mul (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ b * a :=
by { rw [inv_eq_one_div], exact div_le_iff ha }

lemma inv_pos_le_iff_one_le_mul' (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ a * b :=
by { rw [inv_eq_one_div], exact div_le_iff' ha }

lemma inv_pos_lt_iff_one_lt_mul (ha : 0 < a) : a⁻¹ < b ↔ 1 < b * a :=
by { rw [inv_eq_one_div], exact div_lt_iff ha }

lemma inv_pos_lt_iff_one_lt_mul' (ha : 0 < a) : a⁻¹ < b ↔ 1 < a * b :=
by { rw [inv_eq_one_div], exact div_lt_iff' ha }

/-- One direction of `div_le_iff` where `b` is allowed to be `0` (but `c` must be nonnegative) -/
lemma div_le_of_nonneg_of_le_mul (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ c * b) : a / b ≤ c :=
by { rcases eq_or_lt_of_le hb with rfl|hb', simp [hc], rwa [div_le_iff hb'] }

/-- One direction of `div_le_iff` where `c` is allowed to be `0` (but `b` must be nonnegative) -/
lemma mul_le_of_nonneg_of_le_div (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ b / c) : a * c ≤ b :=
begin
  obtain rfl | hc := hc.eq_or_lt,
  { simpa using hb },
  { rwa le_div_iff hc at h }
end

lemma div_le_one_of_le (h : a ≤ b) (hb : 0 ≤ b) : a / b ≤ 1 :=
div_le_of_nonneg_of_le_mul hb zero_le_one $ by rwa one_mul

/-!
### Bi-implications of inequalities using inversions
-/

lemma inv_le_inv_of_le (ha : 0 < a) (h : a ≤ b) : b⁻¹ ≤ a⁻¹ :=
by rwa [← one_div a, le_div_iff' ha, ← div_eq_mul_inv, div_le_iff (ha.trans_le h), one_mul]

/-- See `inv_le_inv_of_le` for the implication from right-to-left with one fewer assumption. -/
lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff ha, ← div_eq_inv_mul, le_div_iff hb, one_mul]

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ ≤ b ↔ b⁻¹ ≤ a`.
See also `inv_le_of_inv_le` for a one-sided implication with one fewer assumption. -/
lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv hb (inv_pos.2 ha), inv_inv]

lemma inv_le_of_inv_le (ha : 0 < a) (h : a⁻¹ ≤ b) : b⁻¹ ≤ a :=
(inv_le ha ((inv_pos.2 ha).trans_le h)).1 h

lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv (inv_pos.2 hb) ha, inv_inv]

/-- See `inv_lt_inv_of_lt` for the implication from right-to-left with one fewer assumption. -/
lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv hb ha)

lemma inv_lt_inv_of_lt (hb : 0 < b) (h : b < a) : a⁻¹ < b⁻¹ :=
(inv_lt_inv (hb.trans h) hb).2 h

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ < b ↔ b⁻¹ < a`.
See also `inv_lt_of_inv_lt` for a one-sided implication with one fewer assumption. -/
lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv hb ha)

lemma inv_lt_of_inv_lt (ha : 0 < a) (h : a⁻¹ < b) : b⁻¹ < a :=
(inv_lt ha ((inv_pos.2 ha).trans h)).1 h

lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le hb ha)

lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 :=
by rwa [inv_lt (zero_lt_one.trans ha) zero_lt_one, inv_one]

lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ :=
by rwa [lt_inv zero_lt_one h₁, inv_one]

lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 :=
by rwa [inv_le (zero_lt_one.trans_le ha) zero_lt_one, inv_one]

lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ :=
by rwa [le_inv zero_lt_one h₁, inv_one]

lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a :=
⟨λ h₁, inv_inv a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩

lemma inv_lt_one_iff : a⁻¹ < 1 ↔ a ≤ 0 ∨ 1 < a :=
begin
  cases le_or_lt a 0 with ha ha,
  { simp [ha, (inv_nonpos.2 ha).trans_lt zero_lt_one] },
  { simp only [ha.not_le, false_or, inv_lt_one_iff_of_pos ha] }
end

lemma one_lt_inv_iff : 1 < a⁻¹ ↔ 0 < a ∧ a < 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans h), inv_inv a ▸ inv_lt_one h⟩, and_imp.2 one_lt_inv⟩

lemma inv_le_one_iff : a⁻¹ ≤ 1 ↔ a ≤ 0 ∨ 1 ≤ a :=
begin
  rcases em (a = 1) with (rfl|ha),
  { simp [le_rfl] },
  { simp only [ne.le_iff_lt (ne.symm ha), ne.le_iff_lt (mt inv_eq_one.1 ha), inv_lt_one_iff] }
end

lemma one_le_inv_iff : 1 ≤ a⁻¹ ↔ 0 < a ∧ a ≤ 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans_le h), inv_inv a ▸ inv_le_one h⟩, and_imp.2 one_le_inv⟩

/-!
### Relating two divisions.
-/

@[mono] lemma div_le_div_of_le (hc : 0 ≤ c) (h : a ≤ b) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 hc)
end

-- Not a `mono` lemma b/c `div_le_div` is strictly more general
lemma div_le_div_of_le_left (ha : 0 ≤ a) (hc : 0 < c) (h : c ≤ b) : a / b ≤ a / c :=
begin
  rw [div_eq_mul_inv, div_eq_mul_inv],
  exact mul_le_mul_of_nonneg_left ((inv_le_inv (hc.trans_le h) hc).mpr h) ha
end

lemma div_le_div_of_le_of_nonneg (hab : a ≤ b) (hc : 0 ≤ c) : a / c ≤ b / c :=
div_le_div_of_le hc hab

lemma div_lt_div_of_lt (hc : 0 < c) (h : a < b) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_pos_right h (one_div_pos.2 hc)
end

lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_lt hc, div_le_div_of_le $ hc.le⟩

lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b :=
lt_iff_lt_of_le_iff_le $ div_le_div_right hc

lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b :=
by simp only [div_eq_mul_inv, mul_lt_mul_left ha, inv_lt_inv hb hc]

lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb)

lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) :
  a / b < c / d ↔ a * d < c * b :=
by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0]

lemma div_le_div_iff (b0 : 0 < b) (d0 : 0 < d) : a / b ≤ c / d ↔ a * d ≤ c * b :=
by rw [le_div_iff d0, div_mul_eq_mul_div, div_le_iff b0]

@[mono] lemma div_le_div (hc : 0 ≤ c) (hac : a ≤ c) (hd : 0 < d) (hbd : d ≤ b) : a / b ≤ c / d :=
by { rw div_le_div_iff (hd.trans_le hbd) hd, exact mul_le_mul hac hbd hd.le hc }

lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans_le hbd) d0).2 (mul_lt_mul hac hbd d0 c0)

lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans hbd) d0).2 (mul_lt_mul' hac hbd d0.le c0)

lemma div_lt_div_of_lt_left (hc : 0 < c) (hb : 0 < b) (h : b < a) : c / a < c / b :=
(div_lt_div_left hc (hb.trans h) hb).mpr h

/-!
### Relating one division and involving `1`
-/

lemma div_le_self (ha : 0 ≤ a) (hb : 1 ≤ b) : a / b ≤ a :=
by simpa only [div_one] using div_le_div_of_le_left ha zero_lt_one hb

lemma div_lt_self (ha : 0 < a) (hb : 1 < b) : a / b < a :=
by simpa only [div_one] using div_lt_div_of_lt_left ha zero_lt_one hb

lemma le_div_self (ha : 0 ≤ a) (hb₀ : 0 < b) (hb₁ : b ≤ 1) : a ≤ a / b :=
by simpa only [div_one] using div_le_div_of_le_left ha hb₀ hb₁

lemma one_le_div (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a :=
by rw [le_div_iff hb, one_mul]

lemma div_le_one (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b :=
by rw [div_le_iff hb, one_mul]

lemma one_lt_div (hb : 0 < b) : 1 < a / b ↔ b < a :=
by rw [lt_div_iff hb, one_mul]

lemma div_lt_one (hb : 0 < b) : a / b < 1 ↔ a < b :=
by rw [div_lt_iff hb, one_mul]

lemma one_div_le (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le ha hb

lemma one_div_lt (ha : 0 < a) (hb : 0 < b) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt ha hb

lemma le_one_div (ha : 0 < a) (hb : 0 < b) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv ha hb

lemma lt_one_div (ha : 0 < a) (hb : 0 < b) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv ha hb

/-!
### Relating two divisions, involving `1`
-/
lemma one_div_le_one_div_of_le (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by simpa using inv_le_inv_of_le ha h

lemma one_div_lt_one_div_of_lt (ha : 0 < a) (h : a < b) : 1 / b < 1 / a :=
by rwa [lt_div_iff' ha, ← div_eq_mul_one_div, div_lt_one (ha.trans h)]

lemma le_of_one_div_le_one_div (ha : 0 < a) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_lt ha) h

lemma lt_of_one_div_lt_one_div (ha : 0 < a) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_le ha) h

/-- For the single implications with fewer assumptions, see `one_div_le_one_div_of_le` and
  `le_of_one_div_le_one_div` -/
lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a :=
div_le_div_left zero_lt_one ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a :=
div_lt_div_left zero_lt_one ha hb

lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a :=
by rwa [lt_one_div zero_lt_one h1, one_div_one]

lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a :=
by rwa [le_one_div zero_lt_one h1, one_div_one]

/-!
### Results about halving.

The equalities also hold in semifields of characteristic `0`.
-/

/- TODO: Unify `add_halves` and `add_halves'` into a single lemma about
`division_semiring` + `char_zero` -/
lemma add_halves (a : α) : a / 2 + a / 2 = a :=
by rw [div_add_div_same, ← two_mul, mul_div_cancel_left a two_ne_zero]

-- TODO: Generalize to `division_semiring`
lemma add_self_div_two (a : α) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero]

lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two

lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one

lemma div_two_lt_of_pos (h : 0 < a) : a / 2 < a :=
by { rw [div_lt_iff (zero_lt_two' α)], exact lt_mul_of_one_lt_right h one_lt_two }

lemma half_lt_self : 0 < a → a / 2 < a := div_two_lt_of_pos

lemma half_le_self (ha_nonneg : 0 ≤ a) : a / 2 ≤ a :=
begin
  by_cases h0 : a = 0,
  { simp [h0], },
  { rw ← ne.def at h0,
    exact (half_lt_self (lt_of_le_of_ne ha_nonneg h0.symm)).le, },
end

lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one

lemma two_inv_lt_one : (2⁻¹ : α) < 1 := (one_div _).symm.trans_lt one_half_lt_one

lemma left_lt_add_div_two : a < (a + b) / 2 ↔ a < b := by simp [lt_div_iff, mul_two]

lemma add_div_two_lt_right : (a + b) / 2 < b ↔ a < b := by simp [div_lt_iff, mul_two]

/-!
### Miscellaneous lemmas
-/

lemma mul_le_mul_of_mul_div_le (h : a * (b / c) ≤ d) (hc : 0 < c) : b * a ≤ d * c :=
begin
  rw [← mul_div_assoc] at h,
  rwa [mul_comm b, ← div_le_iff hc],
end

lemma div_mul_le_div_mul_of_div_le_div (h : a / b ≤ c / d) (he : 0 ≤ e) :
  a / (b * e) ≤ c / (d * e) :=
begin
  rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 he)
end

lemma exists_pos_mul_lt {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b * c < a :=
begin
  have : 0 < a / max (b + 1) 1, from div_pos h (lt_max_iff.2 (or.inr zero_lt_one)),
  refine ⟨a / max (b + 1) 1, this, _⟩,
  rw [← lt_div_iff this, div_div_cancel' h.ne'],
  exact lt_max_iff.2 (or.inl $ lt_add_one _)
end

lemma exists_pos_lt_mul {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b < c * a :=
let ⟨c, hc₀, hc⟩ := exists_pos_mul_lt h b
in ⟨c⁻¹, inv_pos.2 hc₀, by rwa [← div_eq_inv_mul, lt_div_iff hc₀]⟩

lemma monotone.div_const {β : Type*} [preorder β] {f : β → α} (hf : monotone f)
  {c : α} (hc : 0 ≤ c) : monotone (λ x, (f x) / c) :=
begin
  haveI := @linear_order.decidable_le α _,
  simpa only [div_eq_mul_inv] using (monotone_mul_right_of_nonneg (inv_nonneg.2 hc)).comp hf
end

lemma strict_mono.div_const {β : Type*} [preorder β] {f : β → α} (hf : strict_mono f)
  {c : α} (hc : 0 < c) :
  strict_mono (λ x, (f x) / c) :=
by simpa only [div_eq_mul_inv] using hf.mul_const (inv_pos.2 hc)

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_semifield.to_densely_ordered : densely_ordered α :=
{ dense := λ a₁ a₂ h, ⟨(a₁ + a₂) / 2,
  calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm
      ... < (a₁ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_left h _),
  calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_right h _)
                 ... = a₂            : add_self_div_two a₂⟩ }

lemma min_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : min (a / c) (b / c) = (min a b) / c :=
eq.symm $ monotone.map_min (λ x y, div_le_div_of_le hc)

lemma max_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : max (a / c) (b / c) = (max a b) / c :=
eq.symm $ monotone.map_max (λ x y, div_le_div_of_le hc)

lemma one_div_strict_anti_on : strict_anti_on (λ x : α, 1 / x) (set.Ioi 0) :=
λ x x1 y y1 xy, (one_div_lt_one_div (set.mem_Ioi.mp y1) (set.mem_Ioi.mp x1)).mpr xy

lemma one_div_pow_le_one_div_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) :
  1 / a ^ n ≤ 1 / a ^ m :=
by refine (one_div_le_one_div _ _).mpr (pow_le_pow a1 mn);
  exact pow_pos (zero_lt_one.trans_le a1) _

lemma one_div_pow_lt_one_div_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) :
  1 / a ^ n < 1 / a ^ m :=
by refine (one_div_lt_one_div _ _).mpr (pow_lt_pow a1 mn);
  exact pow_pos (trans zero_lt_one a1) _

lemma one_div_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, 1 / a ^ n) :=
λ m n, one_div_pow_le_one_div_pow_of_le a1

lemma one_div_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, 1 / a ^ n) :=
λ m n, one_div_pow_lt_one_div_pow_of_lt a1

lemma inv_strict_anti_on : strict_anti_on (λ x : α, x⁻¹) (set.Ioi 0) :=
λ x hx y hy xy, (inv_lt_inv hy hx).2 xy

lemma inv_pow_le_inv_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) :
  (a ^ n)⁻¹ ≤ (a ^ m)⁻¹ :=
by convert one_div_pow_le_one_div_pow_of_le a1 mn; simp

lemma inv_pow_lt_inv_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) :
  (a ^ n)⁻¹ < (a ^ m)⁻¹ :=
by convert one_div_pow_lt_one_div_pow_of_lt a1 mn; simp

lemma inv_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, (a ^ n)⁻¹) :=
λ m n, inv_pow_le_inv_pow_of_le a1

lemma inv_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, (a ^ n)⁻¹) :=
λ m n, inv_pow_lt_inv_pow_of_lt a1

/-! ### Results about `is_lub` and `is_glb` -/

lemma is_glb.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_glb_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_glb_singleton },
end

lemma is_glb.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

end linear_ordered_semifield

section
variables [linear_ordered_field α] {a b c d : α} {n : ℤ}

/-! ### Lemmas about pos, nonneg, nonpos, neg -/

lemma div_pos_iff : 0 < a / b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := by simp [division_def, mul_pos_iff]
lemma div_neg_iff : a / b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := by simp [division_def, mul_neg_iff]

lemma div_nonneg_iff : 0 ≤ a / b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
by simp [division_def, mul_nonneg_iff]

lemma div_nonpos_iff : a / b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b :=
by simp [division_def, mul_nonpos_iff]

lemma div_nonneg_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a / b :=
div_nonneg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_pos_of_neg_of_neg (ha : a < 0) (hb : b < 0) : 0 < a / b :=
div_pos_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a / b < 0 :=
div_neg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a / b < 0 :=
div_neg_iff.2 $ or.inl ⟨ha, hb⟩

/-! ### Relating one division with another term -/

lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h hc.le,
  λ h, calc
    a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc)
  ... ≥ b * (1 / c)     : mul_le_mul_of_nonpos_right h (one_div_neg.2 hc).le
  ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma div_le_iff_of_neg' (hc : c < 0) : b / c ≤ a ↔ c * a ≤ b :=
by rw [mul_comm, div_le_iff_of_neg hc]

lemma le_div_iff_of_neg (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c :=
by rw [← neg_neg c, mul_neg, div_neg, le_neg,
    div_le_iff (neg_pos.2 hc), neg_mul]

lemma le_div_iff_of_neg' (hc : c < 0) : a ≤ b / c ↔ b ≤ c * a :=
by rw [mul_comm, le_div_iff_of_neg hc]

lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ le_div_iff_of_neg hc

lemma div_lt_iff_of_neg' (hc : c < 0) : b / c < a ↔ c * a < b :=
by rw [mul_comm, div_lt_iff_of_neg hc]

lemma lt_div_iff_of_neg (hc : c < 0) : a < b / c ↔ b < a * c :=
lt_iff_lt_of_le_iff_le $ div_le_iff_of_neg hc

lemma lt_div_iff_of_neg' (hc : c < 0) : a < b / c ↔ b < c * a :=
by rw [mul_comm, lt_div_iff_of_neg hc]

/-! ### Bi-implications of inequalities using inversions -/

lemma inv_le_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff_of_neg ha, ← div_eq_inv_mul, div_le_iff_of_neg hb, one_mul]

lemma inv_le_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv_of_neg hb (inv_lt_zero.2 ha), inv_inv]

lemma le_inv_of_neg (ha : a < 0) (hb : b < 0) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv_of_neg (inv_lt_zero.2 hb) ha, inv_inv]

lemma inv_lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv_of_neg hb ha)

lemma inv_lt_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv_of_neg hb ha)

lemma lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le_of_neg hb ha)

/-! ### Relating two divisions -/

lemma div_le_div_of_nonpos_of_le (hc : c ≤ 0) (h : b ≤ a) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonpos_right h (one_div_nonpos.2 hc)
end

lemma div_lt_div_of_neg_of_lt (hc : c < 0) (h : b < a) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_neg_right h (one_div_neg.2 hc)
end

lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_neg_of_lt hc, div_le_div_of_nonpos_of_le $ hc.le⟩

lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a :=
lt_iff_lt_of_le_iff_le $ div_le_div_right_of_neg hc

/-! ### Relating one division and involving `1` -/

lemma one_le_div_of_neg (hb : b < 0) : 1 ≤ a / b ↔ a ≤ b :=
by rw [le_div_iff_of_neg hb, one_mul]

lemma div_le_one_of_neg (hb : b < 0) : a / b ≤ 1 ↔ b ≤ a :=
by rw [div_le_iff_of_neg hb, one_mul]

lemma one_lt_div_of_neg (hb : b < 0) : 1 < a / b ↔ a < b :=
by rw [lt_div_iff_of_neg hb, one_mul]

lemma div_lt_one_of_neg (hb : b < 0) : a / b < 1 ↔ b < a :=
by rw [div_lt_iff_of_neg hb, one_mul]

lemma one_div_le_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le_of_neg ha hb

lemma one_div_lt_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt_of_neg ha hb

lemma le_one_div_of_neg (ha : a < 0) (hb : b < 0) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv_of_neg ha hb

lemma lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv_of_neg ha hb

lemma one_lt_div_iff : 1 < a / b ↔ 0 < b ∧ b < a ∨ b < 0 ∧ a < b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_lt_div_of_neg] },
  { simp [lt_irrefl, zero_le_one] },
  { simp [hb, hb.not_lt, one_lt_div] }
end

lemma one_le_div_iff : 1 ≤ a / b ↔ 0 < b ∧ b ≤ a ∨ b < 0 ∧ a ≤ b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_le_div_of_neg] },
  { simp [lt_irrefl, zero_lt_one.not_le, zero_lt_one] },
  { simp [hb, hb.not_lt, one_le_div] }
end

lemma div_lt_one_iff : a / b < 1 ↔ 0 < b ∧ a < b ∨ b = 0 ∨ b < 0 ∧ b < a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_lt_one_of_neg] },
  { simp [zero_lt_one], },
  { simp [hb, hb.not_lt, div_lt_one, hb.ne.symm] }
end

lemma div_le_one_iff : a / b ≤ 1 ↔ 0 < b ∧ a ≤ b ∨ b = 0 ∨ b < 0 ∧ b ≤ a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_le_one_of_neg] },
  { simp [zero_le_one], },
  { simp [hb, hb.not_lt, div_le_one, hb.ne.symm] }
end

/-! ### Relating two divisions, involving `1` -/

lemma one_div_le_one_div_of_neg_of_le (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by rwa [div_le_iff_of_neg' hb, ← div_eq_mul_one_div, div_le_one_of_neg (h.trans_lt hb)]

lemma one_div_lt_one_div_of_neg_of_lt (hb : b < 0) (h : a < b) : 1 / b < 1 / a :=
by rwa [div_lt_iff_of_neg' hb, ← div_eq_mul_one_div, div_lt_one_of_neg (h.trans hb)]

lemma le_of_neg_of_one_div_le_one_div (hb : b < 0) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_neg_of_lt hb) h

lemma lt_of_neg_of_one_div_lt_one_div (hb : b < 0) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_neg_of_le hb) h

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_neg_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_le_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ 1 / b ↔ b ≤ a :=
by simpa [one_div] using inv_le_inv_of_neg ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < 1 / b ↔ b < a :=
lt_iff_lt_of_le_iff_le (one_div_le_one_div_of_neg hb ha)

lemma one_div_lt_neg_one (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 :=
suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_lt_one_div_of_neg_of_lt h1 h2

lemma one_div_le_neg_one (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 :=
suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_le_one_div_of_neg_of_le h1 h2

/-! ### Results about halving -/

lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 :=
suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this,
by rw [add_sub_cancel]

lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) :=
suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this,
by rw [sub_add_eq_sub_sub, sub_self, zero_sub]

lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b :=
begin
  rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg,
    ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (zero_lt_two' α)]
end

/--  An inequality involving `2`. -/
lemma sub_one_div_inv_le_two (a2 : 2 ≤ a) : (1 - 1 / a)⁻¹ ≤ 2 :=
begin
  -- Take inverses on both sides to obtain `2⁻¹ ≤ 1 - 1 / a`
  refine (inv_le_inv_of_le (inv_pos.2 $ zero_lt_two' α) _).trans_eq (inv_inv (2 : α)),
  -- move `1 / a` to the left and `1 - 1 / 2 = 1 / 2` to the right to obtain `1 / a ≤ ⅟ 2`
  refine (le_sub_iff_add_le.2 (_ : _ + 2⁻¹ = _ ).le).trans ((sub_le_sub_iff_left 1).2 _),
  { -- show 2⁻¹ + 2⁻¹ = 1
    exact (two_mul _).symm.trans (mul_inv_cancel two_ne_zero) },
  { -- take inverses on both sides and use the assumption `2 ≤ a`.
    exact (one_div a).le.trans (inv_le_inv_of_le zero_lt_two a2) }
end

/-! ### Results about `is_lub` and `is_glb` -/

-- TODO: Generalize to `linear_ordered_semifield`
lemma is_lub.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_lub_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_lub_singleton },
end

-- TODO: Generalize to `linear_ordered_semifield`
lemma is_lub.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

/-! ### Miscellaneous lemmmas -/

lemma mul_sub_mul_div_mul_neg_iff (hc : c ≠ 0) (hd : d ≠ 0) :
  (a * d - b * c) / (c * d) < 0 ↔ a / c < b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_lt_zero]

lemma mul_sub_mul_div_mul_nonpos_iff (hc : c ≠ 0) (hd : d ≠ 0) :
  (a * d - b * c) / (c * d) ≤ 0 ↔ a / c ≤ b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_nonpos]

alias mul_sub_mul_div_mul_neg_iff ↔ div_lt_div_of_mul_sub_mul_div_neg mul_sub_mul_div_mul_neg
alias mul_sub_mul_div_mul_nonpos_iff ↔
  div_le_div_of_mul_sub_mul_div_nonpos mul_sub_mul_div_mul_nonpos

lemma exists_add_lt_and_pos_of_lt (h : b < a) : ∃ c, b + c < a ∧ 0 < c :=
⟨(a - b) / 2, add_sub_div_two_lt h, div_pos (sub_pos_of_lt h) zero_lt_two⟩

lemma le_of_forall_sub_le (h : ∀ ε > 0, b - ε ≤ a) : b ≤ a :=
begin
  contrapose! h,
  simpa only [and_comm ((0 : α) < _), lt_sub_iff_add_lt, gt_iff_lt]
    using exists_add_lt_and_pos_of_lt h,
end

lemma mul_self_inj_of_nonneg (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b :=
mul_self_eq_mul_self_iff.trans $ or_iff_left_of_imp $
  λ h, by { subst a, have : b = 0 := le_antisymm (neg_nonneg.1 a0) b0, rw [this, neg_zero] }

lemma min_div_div_right_of_nonpos (hc : c ≤ 0) (a b : α) : min (a / c) (b / c) = (max a b) / c :=
eq.symm $ antitone.map_max $ λ x y, div_le_div_of_nonpos_of_le hc

lemma max_div_div_right_of_nonpos (hc : c ≤ 0) (a b : α) : max (a / c) (b / c) = (min a b) / c :=
eq.symm $ antitone.map_min $ λ x y, div_le_div_of_nonpos_of_le hc

lemma abs_inv (a : α) : |a⁻¹| = (|a|)⁻¹ := map_inv₀ (abs_hom : α →*₀ α) a
lemma abs_div (a b : α) : |a / b| = |a| / |b| := map_div₀ (abs_hom : α →*₀ α) a b
lemma abs_one_div (a : α) : |1 / a| = 1 / |a| := by rw [abs_div, abs_one]

end


import .le

namespace hidden
namespace myint
open myring
open ordered_myring

theorem intduction (p : myint → Prop) :
p 0 → (∀ {n}, p n → p (n + 1)) → (∀ {n}, p n → p (n - 1)) →
∀ n, p n :=
begin
  assume h0 hnext hprev,
  intro n,
  cases le_total_order (0: myint) n with h0n hn0, {
    rw le_iff_exists_nat at h0n,
    cases h0n with d hd,
    rw zero_add at hd,
    subst hd,
    induction d with n hn, {
      from h0,
    }, {
      from hnext hn,
    },
  }, {
    rw le_iff_exists_nat at hn0,
    cases hn0 with d hd,
    have: n = -↑d, {
      rw ←sub_to_zero_iff_eq,
      rw hd,
      change n + - -↑d = n + ↑d,
      rw neg_neg,
    },
    subst this,
    clear hd,
    induction d with n hn, {
      from h0,
    }, {
      from hprev hn,
    },
  },
end

theorem intduction_from {m : myint} (p : myint → Prop):
(∀ {n}, p n → p (n + 1)) → (∀ {n}, p n → p (n - 1)) →
p m → ∀ n, p n :=
begin
  assume hnext hprev hex,
  suffices : p 0,
    apply intduction, repeat {assumption},
  revert m,
  apply intduction (λ m, p m → p 0), {
    assume h, assumption,
  }, {
    intro n,
    assume h,
    assume hpsn,
    have := hprev hpsn,
    rw sub_def at this,
    rw add_assoc at this,
    rw add_neg at this,
    rw add_zero at this,
    from h this,
  }, {
    intro n,
    assume h,
    assume hpsn,
    have := hnext hpsn,
    rw sub_def at this,
    rw add_assoc at this,
    rw neg_add at this,
    rw add_zero at this,
    from h this,
  },
end

end myint
end hidden


import analysis.complex.upper_half_plane.topology
import analysis.complex.cauchy_integral
import analysis.complex.upper_half_plane.functions_bounded_at_infty
import analysis.calculus.fderiv
import algebra.algebra.basic
import ring_theory.subring.basic
import ring_theory.localization.fraction_ring
import .upper_half_plane_manifold
import .holomorphic_functions
import analysis.complex.basic
import analysis.analytic.isolated_zeros
import analysis.analytic.uniqueness
import algebra.ring.defs
import .ecomplex

open_locale classical
open ecomplex
noncomputable theory

open_locale topological_space upper_half_plane
open complex set upper_half_plane

local notation `ℍ'`:=(⟨upper_half_space , upper_half_plane_is_open⟩: open_subs)

local notation `ℍ`:=upper_half_plane

--instance : has_coe (set ℍ) (set ℂ) := ⟨λ U, has_coe.coe '' U⟩

instance : has_coe (set ℍ') (set ℂ) := ⟨λ U, subtype.val '' U⟩

instance : has_coe (ℂ → ℂ) (ℍ → ℂ) := ⟨λ f, (λ z, f z)⟩

class is_holomorphic_bdd (f : ℍ' → ℂ) : Prop :=
  (diff : is_holomorphic_on f)
  (bdd_at_infty : is_bounded_at_im_infty f)

lemma open_univ : is_open ((univ : set ℍ') : set ℂ) :=
  open_embedding.is_open_map open_embedding_coe _ is_open_univ

lemma mykey' : (has_coe.coe : ℍ' → ℂ) = (λ z, z.val) :=
begin
  finish,
end

lemma mykey : upper_half_space = has_coe.coe '' (univ : set ℍ') :=
begin
  rw mykey',
  finish,
end

lemma analytic_of_holomorphic (f : ℍ' → ℂ) [h : is_holomorphic_bdd f] (z : ℍ') :
analytic_at ℂ (extend_by_zero f) z :=
begin
  have hf : differentiable_on ℂ (extend_by_zero f) (has_coe.coe '' (univ : set ℍ')),
  {
    have j := (is_holomorphic_on_iff_differentiable_on ℍ' f),
    dsimp at j,
    rw ← mykey,
    exact iff.elim_right j h.diff,
  },
  apply differentiable_on.analytic_at hf,
  refine mem_nhds_iff.mpr _,
  use (univ : set ℍ'),
  exact ⟨rfl.subset, open_univ, sorry⟩,--⟨z, by finish⟩⟩,
end

lemma analytic_on_of_holomorphic (f : ℍ' → ℂ) [h : is_holomorphic_bdd f] :
analytic_on ℂ (extend_by_zero f) ℍ' :=
begin
  have hf : differentiable_on ℂ (extend_by_zero f) (upper_half_space),
  {
    have j := (is_holomorphic_on_iff_differentiable_on ℍ' f),
    dsimp at j,
    exact iff.elim_right j h.diff,
  },
  apply differentiable_on.analytic_on hf,
  exact upper_half_plane_is_open,
end

variables (f : ℍ' → ℂ) [is_holomorphic_bdd f] (z : ℍ')

noncomputable def pseries_of_holomorphic := classical.some (analytic_of_holomorphic f z)

lemma pseries_of_holomorphic_def : has_fpower_series_at (extend_by_zero f) (pseries_of_holomorphic f z) z :=
  (classical.some_spec (analytic_of_holomorphic f z))

lemma pseries_unique {z : ℍ} {p : formal_multilinear_series ℂ ℂ ℂ}
(hfp : has_fpower_series_at (extend_by_zero f) p z) : p = pseries_of_holomorphic f z :=
begin
  apply has_fpower_series_at.eq_formal_multilinear_series hfp,
  apply pseries_of_holomorphic_def,
end

@[simp] def hol_order : ℤ := (pseries_of_holomorphic f z).order

lemma hol_order_well_defined {p : formal_multilinear_series ℂ ℂ ℂ}
(hfp : has_fpower_series_at (extend_by_zero f) p z) :  (p.order : ℤ) = hol_order f z :=
  by simp [pseries_unique f hfp]

lemma const_is_bounded (c : ℂ) : is_bounded_at_im_infty (λ z : ℍ', c) :=
begin
simp only [bounded_mem],
use c.abs, use 0,
intros z hz,
linarith,
end

lemma smul_bounded {f : ℍ' → ℂ} (c : ℂ) (hf : is_bounded_at_im_infty f) : is_bounded_at_im_infty (c • f) :=
begin
apply is_bounded_at_im_infty.mul (const_is_bounded c) hf,
end

noncomputable def Holℍ : subring (ℍ' → ℂ) := {
  carrier := is_holomorphic_bdd,
  mul_mem' := λ f g hf hg, ⟨mul_hol f g hf.diff hg.diff,
  is_bounded_at_im_infty.mul hf.bdd_at_infty hg.bdd_at_infty⟩,
  one_mem' := ⟨one_hol ℍ', const_is_bounded 1⟩,
  add_mem' := λ f g hf hg, ⟨add_hol f g hf.diff hg.diff,
  hf.bdd_at_infty.add hg.bdd_at_infty⟩,
  zero_mem' := ⟨zero_hol ℍ', zero_form_is_bounded_at_im_infty⟩,
  neg_mem' := λ f hf, ⟨neg_hol f hf.diff,hf.bdd_at_infty.neg_left⟩
}

instance is_holomorphic_on' (f : Holℍ) : is_holomorphic_bdd f :=
subring.mem_carrier.mpr f.property

def Holℍ.order (f : Holℍ) (z : ℍ) : ℤ := @hol_order f.val f.property z

lemma pseries_neq_zero_function_neq_zero (z : ℍ') (f : Holℍ)
(hp : (pseries_of_holomorphic f z) ≠ 0):
f.val ≠ (0 : ℍ' → ℂ) :=
begin
  intro h,
  have hc : (pseries_of_holomorphic f z) = 0,
  {
    have j : extend_by_zero f.val = 0,
    {
      rw h,
      exact extend_by_zero_zero',
    },
    have p : has_fpower_series_at (extend_by_zero f.val) (pseries_of_holomorphic f z) z,
    {
      apply pseries_of_holomorphic_def,
    },
    rw j at p,
    rw has_fpower_series_at.eq_zero p,
  },
  exact hp hc,
end

lemma preconn_ℍ' : is_preconnected upper_half_space :=
begin
sorry,
end

lemma hol_bdd.eventually_eq_zero_everywhere (f : Holℍ)
  (x : ℍ') (hF : ∀ᶠ z in 𝓝 x, (extend_by_zero f.val) z = 0):
  (extend_by_zero f.val) = (0 : ℂ → ℂ) :=
begin
have hf : analytic_on ℂ (extend_by_zero f.val) ℍ',
{
  --exact analytic_on_of_holomorphic f,
  sorry,
},
have tf : ∀ ⦃y⦄, y ∈ upper_half_space → (extend_by_zero f.val) y = (0 : ℂ → ℂ) y,
{
  exact analytic_on.eq_on_zero_of_preconnected_of_eventually_eq_zero hf preconn_ℍ' x.prop hF,
},

simp at tf,
simp,
sorry,
end

lemma function_neq_zero_forall_z_pseries_neq_zero (f : Holℍ)
(hf : f ≠ 0) : ∀ z : ℍ', (pseries_of_holomorphic f z) ≠ 0 :=
begin
intro z,
have it : f.val ≠ (0 : ℍ' → ℂ),
{
  simp only [subtype.val_eq_coe, ne.def, subring.coe_eq_zero_iff],
  exact hf,
},
intro h,
apply it,
apply extend_by_zero_f_eq_zero,
set F := pseries_of_holomorphic f z with hF,
have G : has_fpower_series_at (extend_by_zero f.val) F z := by {apply pseries_of_holomorphic_def},
rw h at G,
have l := has_fpower_series_at.eventually_eq_zero G,
exact hol_bdd.eventually_eq_zero_everywhere f z l,
end

example (z : ℂ) (U : set ℂ) (hU : is_open U) (hz : z ∈ U): (U ∩ {z}ᶜ).nonempty :=
begin
rw metric.is_open_iff at hU,
specialize hU z hz,
rcases hU with ⟨ε, ⟨hε1, hε2⟩⟩,
use z + ε/2,
apply mem_inter,
{
  apply hε2,
  simp,
  rw abs_of_pos hε1,
  linarith,
},
{
  simp,
  exact ne_of_gt hε1,
}
end

lemma hkey (z : ℂ) (U V V': set ℂ) (hU : U ∈ 𝓝 z)
(hV : {z}ᶜ ⊆ V) (hV' : {z}ᶜ ⊆ V') :
∃ (w : ℂ), w ∈ U ∩ (V ∩ V') ∧ w ≠ z :=
begin
rw mem_nhds_iff at hU,
rcases hU with ⟨U',⟨hU'U,is_open_U', hzU'⟩⟩,
rw metric.is_open_iff at is_open_U',
specialize is_open_U' z hzU',
rcases is_open_U' with ⟨ε, ⟨hε1, hε2⟩⟩,
use z + ε/2,
split,
{
  apply mem_inter,
  {
    apply hU'U,
    apply hε2,
    simp only [metric.mem_ball, dist_self_add_left, norm_eq_abs, map_div₀, abs_of_real, complex.abs_two],
    rw abs_of_pos hε1,
    linarith,
  },
  {
    apply (subset_inter hV hV'),
    simp only [mem_compl_iff, mem_singleton_iff, add_right_eq_self, div_eq_zero_iff, of_real_eq_zero, bit0_eq_zero, one_ne_zero,
    or_false],
    exact ne_of_gt hε1,
  }
},
{
  simp only [ne.def, add_right_eq_self, div_eq_zero_iff, of_real_eq_zero, bit0_eq_zero, one_ne_zero, or_false],
  exact ne_of_gt hε1,
}
end

lemma Holℍ_eq_zero_or_eq_zero_of_mul_eq_zero (f g : Holℍ) (q : f * g = 0) : f = 0 ∨ g = 0 :=
begin
  by_contradiction,
  push_neg at h,
  cases h with hf_ne_zero hg_ne_zero,
  have hc : f * g ≠ 0,
  {
    let i := (⟨0, 1⟩ : ℂ),--(⟨(⟨0, 1⟩ : ℂ), by {simp,} ⟩ : ℍ),
    set F := pseries_of_holomorphic f (⟨i, by {simp only [zero_lt_one],} ⟩ : ℍ) with hF,
    have Fp : has_fpower_series_at (extend_by_zero f.val) F i := by {apply pseries_of_holomorphic_def},
    have rf := function_neq_zero_forall_z_pseries_neq_zero f hf_ne_zero,
    have tf : F ≠ 0 := rf (⟨i, by {simp only [zero_lt_one],} ⟩ : ℍ),
    set G := pseries_of_holomorphic g (⟨i, by {simp only [zero_lt_one],} ⟩ : ℍ) with hG,
    have Gp : has_fpower_series_at (extend_by_zero g.val) G i := by {apply pseries_of_holomorphic_def},
    have rg := function_neq_zero_forall_z_pseries_neq_zero g hg_ne_zero,
    have tg : G ≠ 0 := rg (⟨i, by {simp only [zero_lt_one],} ⟩ : ℍ),
    have ef := has_fpower_series_at.locally_ne_zero Fp tf,
    have eg := has_fpower_series_at.locally_ne_zero Gp tg,

    have aux1 : (extend_by_zero f.val) * (extend_by_zero g.val) ≠ 0,
    {
      rcases ef with ⟨U, ⟨hU, ⟨V, ⟨hV,hfUV⟩⟩⟩⟩,
      rcases eg with ⟨U', ⟨hU', ⟨V', ⟨hV',hgUV'⟩⟩⟩⟩,
      simp only [filter.mem_principal, subtype.val_eq_coe, ne.def] at hfUV hgUV' hV hV',
      let W := V ∩ V',
      have hk : ∃ w, w ∈ (U ∩ U') ∩ W ∧ w ≠ i,
      {
        refine hkey i (U ∩ U') V V' _ hV hV',
        simp only [filter.inter_mem_iff],
        exact ⟨hU, hU'⟩,
      },
      simp only [subtype.val_eq_coe, ne.def],
      rcases hk with ⟨w, hwUW, hwi⟩,
      have hfw : extend_by_zero f.val w ≠ 0,
      {
        have : w ∈ U ∩ V  := ⟨hwUW.1.1, hwUW.2.1⟩,
        rw ← hfUV at this,
        simpa using this,
      },
      have hgw : extend_by_zero g.val w ≠ 0,
      {
        have : w ∈ U' ∩ V' := ⟨hwUW.1.2, hwUW.2.2⟩,
        rw ← hgUV' at this,
        simpa using this,
      },
      have hfgw : (extend_by_zero f.val * extend_by_zero g.val) w ≠ 0,
      {
        change extend_by_zero f.val w * extend_by_zero g.val w ≠ 0,
        exact mul_ne_zero hfw hgw,
      },
      intro hc,
      apply hfgw,
      have hc' : (extend_by_zero ↑f * extend_by_zero ↑g) w = (0 : ℂ → ℂ) w,
      {
        rw hc,
      },
      simpa using hc,
    },
    have aux2 : extend_by_zero (f.val * g.val) ≠ 0,
    {
      rw ← extend_by_zero_mul at aux1,
      exact aux1,
    },
    have aux3 : f.val * g.val ≠ 0,
    {
      exact extend_by_zero_f_neq_zero (f.val * g.val) aux2,
    },
    simp only [subtype.val_eq_coe] at aux3,
    norm_cast at aux3,
  },
  exact hc q,
end

-- Holℍ is an integral domain

instance : is_domain Holℍ := {
  mul_left_cancel_of_ne_zero :=
  begin
    intros f g h hyp1 hyp2,
    have : f*g - f*h = 0 := sub_eq_zero_of_eq hyp2,
    have : f * (g-h) = 0,
    {
      rw [mul_sub, this],
    },
    have : g - h = 0, from (Holℍ_eq_zero_or_eq_zero_of_mul_eq_zero f (g-h) this).resolve_left hyp1,
    exact eq_of_sub_eq_zero this,
  end,
  mul_right_cancel_of_ne_zero :=
  begin
    intros f g h hyp1 hyp2,
      have : f * g - h * g = 0 := sub_eq_zero_of_eq hyp2,
      have : (f - h) * g = 0,
      {
        rw [sub_mul, this],
      },
      have : f - h = 0, from (Holℍ_eq_zero_or_eq_zero_of_mul_eq_zero (f-h) g this).resolve_right hyp1,
      exact eq_of_sub_eq_zero this,
  end,
  exists_pair_ne :=
  begin
    use (λ z : ℍ', 0),
    split,
    exact zero_hol ℍ',
    exact const_is_bounded 0,
    use (λ z : ℍ', 1),
    split,
    exact one_hol ℍ',
    exact const_is_bounded 1,
    simp only [ne.def, subtype.mk_eq_mk, function.const_inj, zero_ne_one, not_false_iff],
  end }

lemma bounded_at_im_infty.smul {f : ℍ' → ℂ} (c : ℂ) (hf : is_bounded_at_im_infty f) :
is_bounded_at_im_infty (λ z : ℍ, c * f z) :=
begin
let h : ℍ' → ℂ := λ z, c,
let j := const_is_bounded c,
exact is_bounded_at_im_infty.mul j hf,
end

instance : has_smul ℂ Holℍ :=
⟨λ r f, ⟨λ z, r * f.val z, ⟨smul_hol r f.val f.prop.diff,
bounded_at_im_infty.smul r f.prop.bdd_at_infty⟩⟩⟩

@[simp] lemma smul_def {f : ℍ' → ℂ} (hf : f ∈ Holℍ) {c : ℂ} : (c • f) = λ z, (c * (f z)) := rfl
@[simp] lemma smul_def' {f : Holℍ} {c : ℂ} : (c • f).val = λ z, (c * (f.val z)) := rfl

lemma comm_Holℍ (f g : Holℍ) : f*g = g*f :=
begin
apply subtype.eq,
simp [mul_comm],
end

instance : algebra ℂ Holℍ :=
{ smul := has_smul.smul,
  to_fun := λ r, ⟨(λ z, r), by {
    split,
    exact const_hol r,
    exact const_is_bounded r,
  }⟩,
  map_one':= rfl,
  map_mul':= λ _ _, rfl,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  commutes' := λ _ _, by {rw comm_Holℍ},
  smul_def' := by {
    intros r f,
    simp,
    apply subtype.eq,
    simp,
    change _  = λ (z : ℍ'), r * f.val z,
    simp,
  }
}

open localization

noncomputable def Merℍ := fraction_ring Holℍ

instance Merℍ_is_field : field Merℍ :=
begin
apply fraction_ring.field,
end

def Merℍ.mk (f : Holℍ) (g : non_zero_divisors Holℍ) : Merℍ := localization.mk f g

def Merℍ.numerator (F : Merℍ) : Holℍ :=
((monoid_of _).sec F).1

-- instance numerator_is_holomorphic (F : Merℍ) : is_holomorphic_on_ℍ F.numerator.val := F.numerator.property

def Merℍ.denominator (F : Merℍ) : (non_zero_divisors Holℍ) :=
((monoid_of _).sec F).2

def Holℍ.zeros (f : Holℍ) := f.val ⁻¹' ({0} : set ℂ)
def Merℍ.zeros (F : Merℍ) : set ℍ' := F.numerator.val ⁻¹' ({0} : set ℂ)
def poles (F : Merℍ) : set ℍ' := F.denominator.val.val ⁻¹' ({0} : set ℂ)

def Merℍ.map (F : Merℍ) : ℍ' → ℂ := λ z, F.numerator.val z / (F.denominator.val.val z)
def tst' (F : Merℍ) : ℍ' → ecomplex := λ z, ite (z ∈ poles F) ⊤ ((F.map) z)

/- example  (f : ℍ' → ecomplex) (S : set ℍ'.1) : ∃! F : Merℍ, tst' F = f :=
begin
sorry
end
 -/

lemma discrete_iff (S : set ℂ) : (discrete_topology S) ↔ ∀ s ∈ S, ∃ (ε : ℝ), 0 < ε ∧ metric.ball s ε ∩ S = {s} :=
begin
  split,
  intros hS s hs,
  rw discrete_topology_iff_nhds at hS,
  sorry,
  sorry,
end

--Given F = f/g a meromorphic function and z ∈ ℍ, we can compute the order of F at z as
--the difference of the order of f and the order of g.
def Merℍ.order (F : Merℍ) (z : ℍ) : ℤ :=
Holℍ.order F.numerator z - Holℍ.order F.denominator z

--next step would be to give the definition of a weakly modular form on the upper half plane.
--from here i could start by trying to state the valence formula.

-- Valuation at ∞:


import .lie_type .sporadic_group

open nat monster
local infix ` ≅ `:60 := isomorphic

/-- Cyclic groups of prime order -/
structure is_cyclic_of_prime_order (G : Group) : Prop :=
(is_cyclic : is_cyclic G)
(is_finite : is_finite G)
(prime_order : prime (G.order is_finite))

/-- The finite simple alternating groups are the even permutations over a finite set with
more than 4 elements. -/
def is_simple_alternating_group (G : Group) : Prop :=
∃n > 4, G ≅ alternating_group n

/-- The simple groups of Lie type consist of the Chevalley groups, Steinberg groups, Ree groups, Suzuki groups and Tits groups -/
def is_of_lie_type (G : Group) : Prop :=
chevalley_group G ∨ steinberg_group G ∨ ree_group G ∨ suzuki_group G ∨ tits_group G

/-- The Mathieu groups are the first happy family of sporadic groups -/
def mathieu_group (G : Group) : Prop :=
G ≅ M11 ∨ G ≅ M12 ∨ G ≅ M22 ∨ G ≅ M23 ∨ G ≅ M24

/-- The second happy family of sporadic groups -/
def second_happy_family (G : Group) : Prop :=
G ≅ Co1 ∨ G ≅ Co2 ∨ G ≅ Co3 ∨ G ≅ McL ∨ G ≅ HS ∨ G ≅ J2 ∨ G ≅ Suz

/-- The third happy family of sporadic groups -/
def third_happy_family (G : Group) : Prop :=
G ≅ Monster ∨ G ≅ BabyMonster ∨ G ≅ Fi24' ∨ G ≅ Fi23 ∨ G ≅ Fi22 ∨ G ≅ Th ∨ G ≅ HN ∨ G ≅ He

/-- The pariahs -/
def pariah (G : Group) : Prop :=
G ≅ J1 ∨ G ≅ J3 ∨ G ≅ Ly ∨ G ≅ O'N ∨ G ≅ J4 ∨ G ≅ Ru

/-- The 26 sporadic groups are the finite simple groups which are not of Lie type -/
def is_sporadic_group (G : Group) : Prop :=
mathieu_group G ∨ second_happy_family G ∨ third_happy_family G ∨ pariah G

/- alternate way of writing this -/
-- inductive sporadic_group (G : Group) : Prop
-- | of_mathieu_group       : mathieu_group G       → sporadic_group
-- | of_second_happy_family : second_happy_family G → sporadic_group
-- | of_third_happy_family  : third_happy_family G  → sporadic_group
-- | of_pariah              : pariah G              → sporadic_group

variable {G : Group}
/-- The classification of finite simple groups: every finite simple group is cyclic, alternating, of Lie type or a sporadic group. -/
theorem classification_of_finite_simple_groups (h₁ : is_finite G) (h₂ : simple_group G) :
  is_cyclic_of_prime_order G ∨
  is_simple_alternating_group G ∨
  is_of_lie_type G ∨
  is_sporadic_group G :=
omitted


import data.nat.basic
import data.pnat

lemma nat.succ_pred (n : ℕ) (h : n ≠ 0) : nat.succ (nat.pred n) = n :=
begin
  cases n,
  contradiction,
  simp
end

def fin.with_max (n m : ℕ) (h : m ≠ 0): fin m :=
⟨ min n (m-1), begin
                 have p := min_le_right n (nat.pred m),
                 have q := nat.lt_succ_of_le p,
                 rw nat.succ_pred at q,
                 exact q,
                 assumption
               end ⟩

lemma pnat.succ_pred (n : ℕ+) : nat.succ (nat.pred n) = n :=
begin
  cases n with n h,
  cases n,
  have := lt_irrefl _ h ; contradiction,
  simp
end

def fin.with_max' (n : ℕ) (m : ℕ+) : fin m :=
⟨ min n (m-1), begin
                 have p := min_le_right n (nat.pred m),
                 have q := nat.lt_succ_of_le p,
                 rw nat.succ_pred at q,
                 exact q,
                 exact nat.pos_iff_ne_zero.mp m.property,
               end ⟩

def CHAR_MAX : ℕ := 0xFF

def nat.trunc_to_char (n : ℕ) : char :=
  if h : n > CHAR_MAX then
    ⟨ CHAR_MAX, by exact dec_trivial ⟩
  else
    ⟨ n, begin
           simp at h,
           left,
           transitivity CHAR_MAX + 1,
           apply nat.lt_succ_of_le,
           assumption,
           exact dec_trivial
         end ⟩


lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl

example (P Q : Prop) : (P → Q) → (¬ Q → ¬ P) :=
begin
    repeat {rw not_iff_imp_false},
    intros pq qf p,
    apply qf,
    apply pq,
    exact p,
end


import algebraic_topology.simplicial_set
import combinatorics.quiver.path
import path_homotopy

open quiver

variable {X : sSet}

-- triangle witnessing composition A -> B -> C = A -> C
lemma triangle (a b c : X _[0]) (ab bc ac : X _[1]) (abc : X _[2])
    {εab : ends ab a b}  {εbc : ends bc b c} {εac : ends ac a c}
    {d0 : X.δ 0 abc = bc} {d1 : X.δ 1 abc = ac} {d2 : X.δ 2 abc = ab} :

    homotopic a c (to_path εac) ((to_path εab) ** (to_path εbc)) :=
begin
    apply homotopic.lift,
    subst d0, subst d1, subst d2,
    apply homotopic''.homotopy,
end

-- commutative square witnessing A -> B -> C = A -> D -> C = A -> C
lemma comm_square (a b c d : X _[0]) (ab bc ad dc ac : X _[1]) (abc adc : X _[2])
    {εab : ends ab a b} {εbc : ends bc b c} {εad : ends ad a d}
    {εdc : ends dc d c} {εac : ends ac a c}
    {_ : X.δ 0 abc = bc} {_ : X.δ 1 abc = ac} {_ : X.δ 2 abc = ab}
    {_ : X.δ 0 adc = dc} {_ : X.δ 1 adc = ac} {_ : X.δ 2 adc = ad} :

    homotopic a c ((to_path εab) ** (to_path εbc)) ((to_path εad) ** (to_path εdc)) :=
begin
    apply homotopic.trans, apply homotopic.symm,
    refine triangle a b c ab bc ac abc; assumption,
    refine triangle a d c ad dc ac adc; assumption,
end

lemma two_triangles (a b c d e : X _[0]) (ab bc ac cd de ce : X _[1]) (abc cde : X _[2])
    {εab : ends ab a b} {εbc : ends bc b c} {εac : ends ac a c}
    {εcd : ends cd c d} {εde : ends de d e} {εce : ends ce c e}

    {_ : X.δ 0 abc = bc} {_ : X.δ 1 abc = ac} {_ : X.δ 2 abc = ab}
    {_ : X.δ 0 cde = de} {_ : X.δ 1 cde = ce} {_ : X.δ 2 cde = cd} :

    homotopic a e ((to_path εac) ** (to_path εce)) ((to_path εab) ** (to_path εbc) ** (to_path εcd) ** (to_path εde)) :=
begin
  have H1 : homotopic a e ((to_path εac) ** (to_path εce)) ((to_path εab) ** (to_path εbc) ** (to_path εce)),
  apply homotopic.comp_r,
  refine triangle a b c ab bc ac abc; assumption,

  have H2 : homotopic a e ((to_path εab) ** (to_path εbc) ** (to_path εce)) ((to_path εab) ** (to_path εbc) ** (to_path εcd) ** (to_path εde)),
  rw path.comp_assoc (to_path εab**to_path εbc),
  apply homotopic.comp_l,
  refine triangle c d e cd de ce cde; assumption,

  apply homotopic.trans, refine H1, refine H2,
end


/-
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

! This file was ported from Lean 3 source module category_theory.lifting_properties.adjunction
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.LiftingProperties.Basic
import Mathlib.CategoryTheory.Adjunction.Basic

/-!

# Lifting properties and adjunction

In this file, we obtain `Adjunction.HasLiftingProperty_iff`, which states
that when we have an adjunction `adj : G ⊣ F` between two functors `G : C ⥤ D`
and `F : D ⥤ C`, then a morphism of the form `G.map i` has the left lifting
property in `D` with respect to a morphism `p` if and only the morphism `i`
has the left lifting property in `C` with respect to `F.map p`.

-/

namespace CategoryTheory

open Category

variable {C D : Type _} [Category C] [Category D] {G : C ⥤ D} {F : D ⥤ C}

namespace CommSq

section

variable {A B : C} {X Y : D} {i : A ⟶ B} {p : X ⟶ Y} {u : G.obj A ⟶ X} {v : G.obj B ⟶ Y}
  (sq : CommSq u (G.map i) p v) (adj : G ⊣ F)

/-- When we have an adjunction `G ⊣ F`, any commutative square where the left
map is of the form `G.map i` and the right map is `p` has an "adjoint" commutative
square whose left map is `i` and whose right map is `F.map p`. -/
theorem right_adjoint : CommSq (adj.homEquiv _ _ u) i (F.map p) (adj.homEquiv _ _ v) :=
  ⟨by
    simp only [Adjunction.homEquiv_unit, assoc, ← F.map_comp, sq.w]
    rw [F.map_comp, Adjunction.unit_naturality_assoc]⟩
#align category_theory.comm_sq.right_adjoint CategoryTheory.CommSq.right_adjoint

/-- The liftings of a commutative are in bijection with the liftings of its (right)
adjoint square. -/
def rightAdjointLiftStructEquiv : sq.LiftStruct ≃ (sq.right_adjoint adj).LiftStruct
    where
  toFun l :=
    { l := adj.homEquiv _ _ l.l
      fac_left := by rw [← adj.homEquiv_naturality_left, l.fac_left]
      fac_right := by rw [← Adjunction.homEquiv_naturality_right, l.fac_right] }
  invFun l :=
    { l := (adj.homEquiv _ _).symm l.l
      fac_left := by
        rw [← Adjunction.homEquiv_naturality_left_symm, l.fac_left]
        apply (adj.homEquiv _ _).left_inv
      fac_right := by
        rw [← Adjunction.homEquiv_naturality_right_symm, l.fac_right]
        apply (adj.homEquiv _ _).left_inv }
  left_inv := by aesop_cat
  right_inv := by aesop_cat
#align category_theory.comm_sq.right_adjoint_lift_struct_equiv CategoryTheory.CommSq.rightAdjointLiftStructEquiv

/-- A square has a lifting if and only if its (right) adjoint square has a lifting. -/
theorem right_adjoint_hasLift_iff : HasLift (sq.right_adjoint adj) ↔ HasLift sq := by
  simp only [HasLift.iff]
  exact Equiv.nonempty_congr (sq.rightAdjointLiftStructEquiv adj).symm
#align category_theory.comm_sq.right_adjoint_has_lift_iff CategoryTheory.CommSq.right_adjoint_hasLift_iff

instance [HasLift sq] : HasLift (sq.right_adjoint adj) := by
  rw [right_adjoint_hasLift_iff]
  infer_instance

end

section

variable {A B : C} {X Y : D} {i : A ⟶ B} {p : X ⟶ Y} {u : A ⟶ F.obj X} {v : B ⟶ F.obj Y}
  (sq : CommSq u i (F.map p) v) (adj : G ⊣ F)

/-- When we have an adjunction `G ⊣ F`, any commutative square where the left
map is of the form `i` and the right map is `F.map p` has an "adjoint" commutative
square whose left map is `G.map i` and whose right map is `p`. -/
theorem left_adjoint : CommSq ((adj.homEquiv _ _).symm u) (G.map i) p ((adj.homEquiv _ _).symm v) :=
  ⟨by
    simp only [Adjunction.homEquiv_counit, assoc, ← G.map_comp_assoc, ← sq.w]
    rw [G.map_comp, assoc, Adjunction.counit_naturality]⟩
#align category_theory.comm_sq.left_adjoint CategoryTheory.CommSq.left_adjoint

/-- The liftings of a commutative are in bijection with the liftings of its (left)
adjoint square. -/
def leftAdjointLiftStructEquiv : sq.LiftStruct ≃ (sq.left_adjoint adj).LiftStruct
    where
  toFun l :=
    { l := (adj.homEquiv _ _).symm l.l
      fac_left := by rw [← adj.homEquiv_naturality_left_symm, l.fac_left]
      fac_right := by rw [← adj.homEquiv_naturality_right_symm, l.fac_right] }
  invFun l :=
    { l := (adj.homEquiv _ _) l.l
      fac_left := by
        rw [← adj.homEquiv_naturality_left, l.fac_left]
        apply (adj.homEquiv _ _).right_inv
      fac_right := by
        rw [← adj.homEquiv_naturality_right, l.fac_right]
        apply (adj.homEquiv _ _).right_inv }
  left_inv := by aesop_cat
  right_inv := by aesop_cat
#align category_theory.comm_sq.left_adjoint_lift_struct_equiv CategoryTheory.CommSq.leftAdjointLiftStructEquiv

/-- A (left) adjoint square has a lifting if and only if the original square has a lifting. -/
theorem left_adjoint_hasLift_iff : HasLift (sq.left_adjoint adj) ↔ HasLift sq := by
  simp only [HasLift.iff]
  exact Equiv.nonempty_congr (sq.leftAdjointLiftStructEquiv adj).symm
#align category_theory.comm_sq.left_adjoint_has_lift_iff CategoryTheory.CommSq.left_adjoint_hasLift_iff

instance [HasLift sq] : HasLift (sq.left_adjoint adj) := by
  rw [left_adjoint_hasLift_iff]
  infer_instance

end

end CommSq

namespace Adjunction

theorem hasLiftingProperty_iff (adj : G ⊣ F) {A B : C} {X Y : D} (i : A ⟶ B) (p : X ⟶ Y) :
    HasLiftingProperty (G.map i) p ↔ HasLiftingProperty i (F.map p) := by
  constructor <;> intro <;> constructor <;> intro f g sq
  · rw [← sq.left_adjoint_hasLift_iff adj]
    infer_instance
  · rw [← sq.right_adjoint_hasLift_iff adj]
    infer_instance
#align category_theory.adjunction.has_lifting_property_iff CategoryTheory.Adjunction.hasLiftingProperty_iff

end Adjunction

end CategoryTheory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.natural_transformation
import Mathlib.category_theory.discrete_category
import Mathlib.algebra.group.hom
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Monoids as discrete monoidal categories

The discrete category on a monoid is a monoidal category.
Multiplicative morphisms induced monoidal functors.
-/

namespace category_theory

protected instance monoid_discrete (M : Type u) [monoid M] : monoid (discrete M) := id _inst_1

protected instance discrete.monoidal_category (M : Type u) [monoid M] :
    monoidal_category (discrete M) :=
  monoidal_category.mk (fun (X Y : discrete M) => X * Y)
    (fun (W X Y Z : discrete M) (f : W ⟶ X) (g : Y ⟶ Z) => eq_to_hom sorry) 1
    (fun (X Y Z : discrete M) => eq_to_iso sorry) (fun (X : discrete M) => eq_to_iso sorry)
    fun (X : discrete M) => eq_to_iso sorry

/--
A multiplicative morphism between monoids gives a monoidal functor between the corresponding
discrete monoidal categories.
-/
@[simp] theorem discrete.monoidal_functor_μ_is_iso {M : Type u} [monoid M] {N : Type u} [monoid N]
    (F : M →* N) (X : discrete M) (Y : discrete M) :
    monoidal_functor.μ_is_iso (discrete.monoidal_functor F) X Y =
        discrete.category_theory.is_iso
          (lax_monoidal_functor.μ
            (lax_monoidal_functor.mk
              (functor.mk ⇑F
                fun (X Y : discrete M) (f : X ⟶ Y) =>
                  eq_to_hom (discrete.monoidal_functor._proof_1 F X Y f))
              (eq_to_hom (discrete.monoidal_functor._proof_4 F))
              fun (X Y : discrete M) => eq_to_hom (discrete.monoidal_functor._proof_5 F X Y))
            X Y) :=
  Eq.refl (monoidal_functor.μ_is_iso (discrete.monoidal_functor F) X Y)

/--
The monoidal natural isomorphism corresponding to composing two multiplicative morphisms.
-/
def discrete.monoidal_functor_comp {M : Type u} [monoid M] {N : Type u} [monoid N] {K : Type u}
    [monoid K] (F : M →* N) (G : N →* K) :
    discrete.monoidal_functor F ⊗⋙ discrete.monoidal_functor G ≅
        discrete.monoidal_functor (monoid_hom.comp G F) :=
  iso.mk (monoidal_nat_trans.mk (nat_trans.mk fun (X : discrete M) => 𝟙))
    (monoidal_nat_trans.mk (nat_trans.mk fun (X : discrete M) => 𝟙))

end Mathlib


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

! This file was ported from Lean 3 source module data.list.tfae
! leanprover-community/mathlib commit 00f4ab49e7d5139216e0b3daad15fffa504897ab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Basic

/-!
# The Following Are Equivalent

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

This file allows to state that all propositions in a list are equivalent. It is used by
`tactic.tfae`.
`tfae l` means `∀ x ∈ l, ∀ y ∈ l, x ↔ y`. This is equivalent to `pairwise (↔) l`.
-/

namespace List

#print List.TFAE /-
/-- tfae: The Following (propositions) Are Equivalent.

The `tfae_have` and `tfae_finish` tactics can be useful in proofs with `tfae` goals.
-/
def TFAE (l : List Prop) : Prop :=
  ∀ x ∈ l, ∀ y ∈ l, x ↔ y
#align list.tfae List.TFAE
-/

#print List.tfae_nil /-
theorem tfae_nil : TFAE [] :=
  forall_mem_nil _
#align list.tfae_nil List.tfae_nil
-/

#print List.tfae_singleton /-
theorem tfae_singleton (p) : TFAE [p] := by simp [tfae, -eq_iff_iff]
#align list.tfae_singleton List.tfae_singleton
-/

#print List.tfae_cons_of_mem /-
theorem tfae_cons_of_mem {a b} {l : List Prop} (h : b ∈ l) : TFAE (a :: l) ↔ (a ↔ b) ∧ TFAE l :=
  ⟨fun H => ⟨H a (by simp) b (Or.inr h), fun p hp q hq => H _ (Or.inr hp) _ (Or.inr hq)⟩,
    by
    rintro ⟨ab, H⟩ p (rfl | hp) q (rfl | hq)
    · rfl
    · exact ab.trans (H _ h _ hq)
    · exact (ab.trans (H _ h _ hp)).symm
    · exact H _ hp _ hq⟩
#align list.tfae_cons_of_mem List.tfae_cons_of_mem
-/

#print List.tfae_cons_cons /-
theorem tfae_cons_cons {a b} {l : List Prop} : TFAE (a :: b :: l) ↔ (a ↔ b) ∧ TFAE (b :: l) :=
  tfae_cons_of_mem (Or.inl rfl)
#align list.tfae_cons_cons List.tfae_cons_cons
-/

#print List.tfae_of_forall /-
theorem tfae_of_forall (b : Prop) (l : List Prop) (h : ∀ a ∈ l, a ↔ b) : TFAE l :=
  fun a₁ h₁ a₂ h₂ => (h _ h₁).trans (h _ h₂).symm
#align list.tfae_of_forall List.tfae_of_forall
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:219:4: warning: unsupported binary notation `«->» -/
#print List.tfae_of_cycle /-
theorem tfae_of_cycle {a b} {l : List Prop} :
    List.Chain («->» · ·) a (b :: l) → (ilast' b l → a) → TFAE (a :: b :: l) :=
  by
  induction' l with c l IH generalizing a b <;>
    simp only [tfae_cons_cons, tfae_singleton, and_true_iff, chain_cons, chain.nil] at *
  · intro a b
    exact Iff.intro a b
  rintro ⟨ab, ⟨bc, ch⟩⟩ la
  have := IH ⟨bc, ch⟩ (ab ∘ la)
  exact ⟨⟨ab, la ∘ (this.2 c (Or.inl rfl) _ (ilast'_mem _ _)).1 ∘ bc⟩, this⟩
#align list.tfae_of_cycle List.tfae_of_cycle
-/

#print List.TFAE.out /-
theorem TFAE.out {l} (h : TFAE l) (n₁ n₂) {a b} (h₁ : List.get? l n₁ = some a := by rfl)
    (h₂ : List.get? l n₂ = some b := by rfl) : a ↔ b :=
  h _ (List.get?_mem h₁) _ (List.get?_mem h₂)
#align list.tfae.out List.TFAE.out
-/

end List


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.direct_sum.basic
import linear_algebra.dfinsupp

/-!
# Direct sum of modules

The first part of the file provides constructors for direct sums of modules. It provides a
construction of the direct sum using the universal property and proves its uniqueness
(`direct_sum.to_module.unique`).

The second part of the file covers the special case of direct sums of submodules of a fixed module
`M`.  There is a canonical linear map from this direct sum to `M` (`direct_sum.coe_linear_map`), and
the construction is of particular importance when this linear map is an equivalence; that is, when
the submodules provide an internal decomposition of `M`.  The property is defined more generally
elsewhere as `direct_sum.is_internal`, but its basic consequences on `submodule`s are established
in this file.

-/

universes u v w u₁

namespace direct_sum
open_locale direct_sum

section general
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include R
variables {M : ι → Type w} [Π i, add_comm_monoid (M i)] [Π i, module R (M i)]

instance : module R (⨁ i, M i) := dfinsupp.module
instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] :
  smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class
instance {S : Type*} [semiring S] [has_smul R S] [Π i, module S (M i)]
  [Π i, is_scalar_tower R S (M i)] :
  is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower
instance [Π i, module Rᵐᵒᵖ (M i)] [Π i, is_central_scalar R (M i)] :
  is_central_scalar R (⨁ i, M i) := dfinsupp.is_central_scalar

lemma smul_apply (b : R) (v : ⨁ i, M i) (i : ι) :
  (b • v) i = b • (v i) := dfinsupp.smul_apply _ _ _

include dec_ι

variables R ι M
/-- Create the direct sum given a family `M` of `R` modules indexed over `ι`. -/
def lmk : Π s : finset ι, (Π i : (↑s : set ι), M i.val) →ₗ[R] (⨁ i, M i) :=
dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof : Π i : ι, M i →ₗ[R] (⨁ i, M i) :=
dfinsupp.lsingle

lemma lof_eq_of (i : ι) (b : M i) : lof R ι M i b = of M i b := rfl

variables {ι M}

lemma single_eq_lof (i : ι) (b : M i) :
  dfinsupp.single i b = lof R ι M i b := rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (s : finset ι) (c : R) (x) : mk M s (c • x) = c • mk M s x :=
(lmk R ι M s).map_smul c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (i : ι) (c : R) (x) : of M i (c • x) = c • of M i x :=
(lof R ι M i).map_smul c x

variables {R}
lemma support_smul [Π (i : ι) (x : M i), decidable (x ≠ 0)]
  (c : R) (v : ⨁ i, M i) : (c • v).support ⊆ v.support := dfinsupp.support_smul _ _

variables {N : Type u₁} [add_comm_monoid N] [module R N]
variables (φ : Π i, M i →ₗ[R] N)

variables (R ι N φ)
/-- The linear map constructed using the universal property of the coproduct. -/
def to_module : (⨁ i, M i) →ₗ[R] N :=
dfinsupp.lsum ℕ φ

/-- Coproducts in the categories of modules and additive monoids commute with the forgetful functor
from modules to additive monoids. -/
lemma coe_to_module_eq_coe_to_add_monoid :
  (to_module R ι N φ : (⨁ i, M i) → N) = to_add_monoid (λ i, (φ i).to_add_monoid_hom) :=
rfl

variables {ι N φ}

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] lemma to_module_lof (i) (x : M i) : to_module R ι N φ (lof R ι M i x) = φ i x :=
to_add_monoid_of (λ i, (φ i).to_add_monoid_hom) i x

variables (ψ : (⨁ i, M i) →ₗ[R] N)

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (f : ⨁ i, M i) : ψ f = to_module R ι N (λ i, ψ.comp $ lof R ι M i) f :=
to_add_monoid.unique ψ.to_add_monoid_hom f

variables {ψ} {ψ' : (⨁ i, M i) →ₗ[R] N}

/-- Two `linear_map`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
theorem linear_map_ext ⦃ψ ψ' : (⨁ i, M i) →ₗ[R] N⦄
  (H : ∀ i, ψ.comp (lof R ι M i) = ψ'.comp (lof R ι M i)) : ψ = ψ' :=
dfinsupp.lhom_ext' H

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), M i) →ₗ[R] (⨁ (i : T), M i) :=
to_module R _ _ $ λ i, lof R T (λ (i : subtype T), M i) ⟨i, H i.prop⟩

omit dec_ι

variables (ι M)
/-- Given `fintype α`, `linear_equiv_fun_on_fintype R` is the natural `R`-linear equivalence
between `⨁ i, M i` and `Π i, M i`. -/
@[simps apply] def linear_equiv_fun_on_fintype [fintype ι] :
  (⨁ i, M i) ≃ₗ[R] (Π i, M i) :=
{ to_fun := coe_fn,
  map_add' := λ f g, by { ext, simp only [add_apply, pi.add_apply] },
  map_smul' := λ c f, by { ext, simp only [dfinsupp.coe_smul, ring_hom.id_apply] },
  .. dfinsupp.equiv_fun_on_fintype }

variables {ι M}
@[simp] lemma linear_equiv_fun_on_fintype_lof [fintype ι] [decidable_eq ι] (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M) (lof R ι M i m) = pi.single i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype (lof R ι M i m)) a = _,
  convert _root_.congr_fun (dfinsupp.equiv_fun_on_fintype_single i m) a,
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_single [fintype ι] [decidable_eq ι]
  (i : ι) (m : M i) :
  (linear_equiv_fun_on_fintype R ι M).symm (pi.single i m) = lof R ι M i m :=
begin
  ext a,
  change (dfinsupp.equiv_fun_on_fintype.symm (pi.single i m)) a = _,
  rw (dfinsupp.equiv_fun_on_fintype_symm_single i m),
  refl
end

@[simp] lemma linear_equiv_fun_on_fintype_symm_coe [fintype ι] (f : ⨁ i, M i) :
  (linear_equiv_fun_on_fintype R ι M).symm f = f :=
by { ext, simp [linear_equiv_fun_on_fintype], }

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [module R M]
  [unique ι] :
  (⨁ (_ : ι), M) ≃ₗ[R] M :=
{ .. direct_sum.id M ι,
  .. to_module R ι M (λ i, linear_map.id) }

variables (ι M)
/-- The projection map onto one component, as a linear map. -/
def component (i : ι) : (⨁ i, M i) →ₗ[R] M i :=
dfinsupp.lapply i

variables {ι M}

lemma apply_eq_component (f : ⨁ i, M i) (i : ι) :
  f i = component R ι M i f := rfl

@[ext] lemma ext {f g : ⨁ i, M i}
  (h : ∀ i, component R ι M i f = component R ι M i g) : f = g :=
dfinsupp.ext h

lemma ext_iff {f g : ⨁ i, M i} : f = g ↔
  ∀ i, component R ι M i f = component R ι M i g :=
⟨λ h _, by rw h, ext R⟩

include dec_ι

@[simp] lemma lof_apply (i : ι) (b : M i) : ((lof R ι M i) b) i = b :=
dfinsupp.single_eq_same

@[simp] lemma component.lof_self (i : ι) (b : M i) :
  component R ι M i ((lof R ι M i) b) = b :=
lof_apply R i b

lemma component.of (i j : ι) (b : M j) :
  component R ι M i ((lof R ι M j) b) =
  if h : j = i then eq.rec_on h b else 0 :=
dfinsupp.single_apply

omit dec_ι
section congr_left
variables {κ : Type*}

/--Reindexing terms of a direct sum is linear.-/
def lequiv_congr_left (h : ι ≃ κ) : (⨁ i, M i) ≃ₗ[R] ⨁ k, M (h.symm k) :=
{ map_smul' := dfinsupp.comap_domain'_smul _ _,
  ..equiv_congr_left h }

@[simp] lemma lequiv_congr_left_apply (h : ι ≃ κ) (f : ⨁ i, M i) (k : κ) :
lequiv_congr_left R h f k = f (h.symm k) := equiv_congr_left_apply _ _ _

end congr_left

section sigma
variables {α : ι → Type*} {δ : Π i, α i → Type w}
variables [Π i j, add_comm_monoid (δ i j)] [Π i j, module R (δ i j)]

/--`curry` as a linear map.-/
noncomputable def sigma_lcurry : (⨁ (i : Σ i, _), δ i.1 i.2) →ₗ[R] ⨁ i j, δ i j :=
{ map_smul' := λ r, by convert (@dfinsupp.sigma_curry_smul _ _ _ δ _ _ _ r),
  ..sigma_curry }

@[simp] lemma sigma_lcurry_apply (f : ⨁ (i : Σ i, _), δ i.1 i.2) (i : ι) (j : α i) :
  sigma_lcurry R f i j = f ⟨i, j⟩ := sigma_curry_apply f i j

/--`uncurry` as a linear map.-/
noncomputable def sigma_luncurry : (⨁ i j, δ i j) →ₗ[R] ⨁ (i : Σ i, _), δ i.1 i.2 :=
{ map_smul' := dfinsupp.sigma_uncurry_smul,
  ..sigma_uncurry }

@[simp] lemma sigma_luncurry_apply (f : ⨁ i j, δ i j) (i : ι) (j : α i) :
  sigma_luncurry R f ⟨i, j⟩ = f i j := sigma_uncurry_apply f i j

/--`curry_equiv` as a linear equiv.-/
noncomputable def sigma_lcurry_equiv : (⨁ (i : Σ i, _), δ i.1 i.2) ≃ₗ[R] ⨁ i j, δ i j :=
{ ..sigma_curry_equiv, ..sigma_lcurry R }

end sigma

section option
variables {α : option ι → Type w} [Π i, add_comm_monoid (α i)] [Π i, module R (α i)]
include dec_ι

/--Linear isomorphism obtained by separating the term of index `none` of a direct sum over
`option ι`.-/
@[simps] noncomputable def lequiv_prod_direct_sum : (⨁ i, α i) ≃ₗ[R] α none × ⨁ i, α (some i) :=
{ map_smul' := dfinsupp.equiv_prod_dfinsupp_smul,
  ..add_equiv_prod_direct_sum }

end option

end general

section submodule

section semiring
variables {R : Type u} [semiring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_monoid M] [module R M]
variables (A : ι → submodule R M)

/-- The canonical embedding from `⨁ i, A i` to `M`  where `A` is a collection of `submodule R M`
indexed by `ι`. This is `direct_sum.coe_add_monoid_hom` as a `linear_map`. -/
def coe_linear_map : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype)

@[simp] lemma coe_linear_map_of (i : ι) (x : A i) :
  direct_sum.coe_linear_map A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

variables {A}

/-- If a direct sum of submodules is internal then the submodules span the module. -/
lemma is_internal.submodule_supr_eq_top (h : is_internal A) : supr A = ⊤ :=
begin
  rw [submodule.supr_eq_range_dfinsupp_lsum, linear_map.range_eq_top],
  exact function.bijective.surjective h,
end

/-- If a direct sum of submodules is internal then the submodules are independent. -/
lemma is_internal.submodule_independent (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_lsum_injective _ h.injective

/-- Given an internal direct sum decomposition of a module `M`, and a basis for each of the
components of the direct sum, the disjoint union of these bases is a basis for `M`. -/
noncomputable def is_internal.collected_basis
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  basis (Σ i, α i) R M :=
{ repr :=
    (linear_equiv.of_bijective (direct_sum.coe_linear_map A) h.injective h.surjective).symm ≪≫ₗ
      (dfinsupp.map_range.linear_equiv (λ i, (v i).repr)) ≪≫ₗ
      (sigma_finsupp_lequiv_dfinsupp R).symm }

@[simp] lemma is_internal.collected_basis_coe
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) :
  ⇑(h.collected_basis v) = λ a : Σ i, (α i), ↑(v a.1 a.2) :=
begin
  funext a,
  simp only [is_internal.collected_basis, to_module, coe_linear_map,
    add_equiv.to_fun_eq_coe, basis.coe_of_repr, basis.repr_symm_apply, dfinsupp.lsum_apply_apply,
    dfinsupp.map_range.linear_equiv_apply, dfinsupp.map_range.linear_equiv_symm,
    dfinsupp.map_range_single, finsupp.total_single, linear_equiv.of_bijective_apply,
    linear_equiv.symm_symm, linear_equiv.symm_trans_apply, one_smul,
    sigma_finsupp_add_equiv_dfinsupp_apply, sigma_finsupp_equiv_dfinsupp_single,
    sigma_finsupp_lequiv_dfinsupp_apply],
  convert dfinsupp.sum_add_hom_single (λ i, (A i).subtype.to_add_monoid_hom) a.1 (v a.1 a.2),
end

lemma is_internal.collected_basis_mem
  (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) :
  h.collected_basis v a ∈ A a.1 :=
by simp

/-- When indexed by only two distinct elements, `direct_sum.is_internal` implies
the two submodules are complementary. Over a `ring R`, this is true as an iff, as
`direct_sum.is_internal_iff_is_compl`. --/
lemma is_internal.is_compl {A : ι → submodule R M} {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) (hi : is_internal A) : is_compl (A i) (A j) :=
⟨hi.submodule_independent.pairwise_disjoint _ _ hij, eq.le $ hi.submodule_supr_eq_top.symm.trans $
  by rw [←Sup_pair, supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton]⟩

end semiring

section ring
variables {R : Type u} [ring R]
variables {ι : Type v} [dec_ι : decidable_eq ι]
include dec_ι
variables {M : Type*} [add_comm_group M] [module R M]

/-- Note that this is not generally true for `[semiring R]`; see
`complete_lattice.independent.dfinsupp_lsum_injective` for details. -/
lemma is_internal_submodule_of_independent_of_supr_eq_top {A : ι → submodule R M}
  (hi : complete_lattice.independent A) (hs : supr A = ⊤) : is_internal A :=
⟨hi.dfinsupp_lsum_injective, linear_map.range_eq_top.1 $
  (submodule.supr_eq_range_dfinsupp_lsum _).symm.trans hs⟩

/-- `iff` version of `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top`,
`direct_sum.is_internal.independent`, and `direct_sum.is_internal.supr_eq_top`.
-/
lemma is_internal_submodule_iff_independent_and_supr_eq_top (A : ι → submodule R M) :
    is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ :=
⟨λ i, ⟨i.submodule_independent, i.submodule_supr_eq_top⟩,
 and.rec is_internal_submodule_of_independent_of_supr_eq_top⟩

/-- If a collection of submodules has just two indices, `i` and `j`, then
`direct_sum.is_internal` is equivalent to `is_compl`. -/
lemma is_internal_submodule_iff_is_compl (A : ι → submodule R M) {i j : ι} (hij : i ≠ j)
  (h : (set.univ : set ι) = {i, j}) :
  is_internal A ↔ is_compl (A i) (A j) :=
begin
  have : ∀ k, k = i ∨ k = j := λ k, by simpa using set.ext_iff.mp h k,
  rw [is_internal_submodule_iff_independent_and_supr_eq_top,
    supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton, Sup_pair,
    complete_lattice.independent_pair hij this],
  exact ⟨λ ⟨hd, ht⟩, ⟨hd, ht.ge⟩, λ ⟨hd, ht⟩, ⟨hd, eq_top_iff.mpr ht⟩⟩,
end

/-! Now copy the lemmas for subgroup and submonoids. -/

lemma is_internal.add_submonoid_independent {M : Type*} [add_comm_monoid M]
  {A : ι → add_submonoid M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective _ h.injective

lemma is_internal.add_subgroup_independent {M : Type*} [add_comm_group M]
  {A : ι → add_subgroup M} (h : is_internal A) :
  complete_lattice.independent A :=
complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' _ h.injective

end ring

end submodule

end direct_sum