/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import order.filter.basic
import data.set.countable

/-!
# Filters with countable intersection property

In this file we define `countable_Inter_filter` to be the class of filters with the following
property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.

Two main examples are the `residual` filter defined in `topology.metric_space.baire` and
the `measure.ae` filter defined in `measure_theory.measure_space`.

We reformulate the definition in terms of indexed intersection and in terms of `filter.eventually`
and provide instances for some basic constructions (`⊥`, `⊤`, `filter.principal`, `filter.map`,
`filter.comap`, `has_inf.inf`). We also provide a custom constructor `filter.of_countable_Inter`
that deduces two axioms of a `filter` from the countable intersection property.

## Tags
filter, countable
-/

open set filter
open_locale filter

variables {ι α β : Type*}

/-- A filter `l` has the countable intersection property if for any countable collection
of sets `s ∈ l` their intersection belongs to `l` as well. -/
class countable_Inter_filter (l : filter α) : Prop :=
(countable_sInter_mem' :
  ∀ {S : set (set α)} (hSc : S.countable) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l)

variables {l : filter α} [countable_Inter_filter l]

lemma countable_sInter_mem {S : set (set α)} (hSc : S.countable) :
  ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
⟨λ hS s hs, mem_of_superset hS (sInter_subset_of_mem hs),
  countable_Inter_filter.countable_sInter_mem' hSc⟩

lemma countable_Inter_mem [encodable ι] {s : ι → set α} :
  (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
sInter_range s ▸ (countable_sInter_mem (countable_range _)).trans forall_range_iff

lemma countable_bInter_mem {S : set ι} (hS : S.countable) {s : Π i ∈ S, set α} :
  (⋂ i ∈ S, s i ‹_›) ∈ l ↔  ∀ i ∈ S, s i ‹_› ∈ l :=
begin
  rw [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact countable_Inter_mem.trans subtype.forall
end

lemma eventually_countable_forall [encodable ι] {p : α → ι → Prop} :
  (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_Inter_mem _ _ l _ _ (λ i, {x | p x i})

lemma eventually_countable_ball {S : set ι} (hS : S.countable) {p : Π (x : α) (i ∈ S), Prop} :
  (∀ᶠ x in l, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᶠ x in l, p x i ‹_› :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_bInter_mem _ _ l _ _ hS (λ i hi, {x | p x i hi})

lemma eventually_le.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Union.2 $
  (mem_Union.1 hs).imp hst

lemma eventually_eq.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
(eventually_le.countable_Union (λ i, (h i).le)).antisymm
  (eventually_le.countable_Union (λ i, (h i).symm.le))

lemma eventually_le.countable_bUnion {S : set ι} (hS : S.countable) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
begin
  simp only [bUnion_eq_Union],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Union (λ i, h i i.2)
end

lemma eventually_eq.countable_bUnion {S : set ι} (hS : S.countable) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
(eventually_le.countable_bUnion hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bUnion hS (λ i hi, (h i hi).symm.le))

lemma eventually_le.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Inter.2 $ λ i, hst _ (mem_Inter.1 hs i)

lemma eventually_eq.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
(eventually_le.countable_Inter (λ i, (h i).le)).antisymm
  (eventually_le.countable_Inter (λ i, (h i).symm.le))

lemma eventually_le.countable_bInter {S : set ι} (hS : S.countable) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
begin
  simp only [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Inter (λ i, h i i.2)
end

lemma eventually_eq.countable_bInter {S : set ι} (hS : S.countable) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
(eventually_le.countable_bInter hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bInter hS (λ i hi, (h i hi).symm.le))

/-- Construct a filter with countable intersection property. This constructor deduces
`filter.univ_sets` and `filter.inter_sets` from the countable intersection property. -/
def filter.of_countable_Inter (l : set (set α))
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
  filter α :=
{ sets := l,
  univ_sets := @sInter_empty α ▸ hp _ countable_empty (empty_subset _),
  sets_of_superset := h_mono,
  inter_sets := λ s t hs ht, sInter_pair s t ▸
    hp _ ((countable_singleton _).insert _) (insert_subset.2 ⟨hs, singleton_subset_iff.2 ht⟩) }

instance filter.countable_Inter_of_countable_Inter (l : set (set α))
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
  countable_Inter_filter (filter.of_countable_Inter l hp h_mono) := ⟨hp⟩

@[simp] lemma filter.mem_of_countable_Inter {l : set (set α)}
  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
  (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) {s : set α} :
  s ∈ filter.of_countable_Inter l hp h_mono ↔ s ∈ l :=
iff.rfl

instance countable_Inter_filter_principal (s : set α) : countable_Inter_filter (𝓟 s) :=
⟨λ S hSc hS, subset_sInter hS⟩

instance countable_Inter_filter_bot : countable_Inter_filter (⊥ : filter α) :=
by { rw ← principal_empty, apply countable_Inter_filter_principal }

instance countable_Inter_filter_top : countable_Inter_filter (⊤ : filter α) :=
by { rw ← principal_univ, apply countable_Inter_filter_principal }

instance (l : filter β) [countable_Inter_filter l] (f : α → β) :
  countable_Inter_filter (comap f l) :=
begin
  refine ⟨λ S hSc hS, _⟩,
  choose! t htl ht using hS,
  have : (⋂ s ∈ S, t s) ∈ l, from (countable_bInter_mem hSc).2 htl,
  refine ⟨_, this, _⟩,
  simpa [preimage_Inter] using (Inter₂_mono ht)
end

instance (l : filter α) [countable_Inter_filter l] (f : α → β) :
  countable_Inter_filter (map f l) :=
begin
  constructor, intros S hSc hS,
  simp only [mem_map, sInter_eq_bInter, preimage_Inter₂] at hS ⊢,
  exact (countable_bInter_mem hSc).2 hS
end

/-- Infimum of two `countable_Inter_filter`s is a `countable_Inter_filter`. This is useful, e.g.,
to automatically get an instance for `residual α ⊓ 𝓟 s`. -/
instance countable_Inter_filter_inf (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊓ l₂) :=
begin
  refine ⟨λ S hSc hS, _⟩,
  choose s hs t ht hst using hS,
  replace hs : (⋂ i ∈ S, s i ‹_›) ∈ l₁ := (countable_bInter_mem hSc).2 hs,
  replace ht : (⋂ i ∈ S, t i ‹_›) ∈ l₂ := (countable_bInter_mem hSc).2 ht,
  refine mem_of_superset (inter_mem_inf hs ht) (subset_sInter $ λ i hi, _),
  rw hst i hi,
  apply inter_subset_inter ; exact Inter_subset_of_subset i (Inter_subset _ _)
end

/-- Supremum of two `countable_Inter_filter`s is a `countable_Inter_filter`. -/
instance countable_Inter_filter_sup (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊔ l₂) :=
begin
  refine ⟨λ S hSc hS, ⟨_, _⟩⟩; refine (countable_sInter_mem hSc).2 (λ s hs, _),
  exacts [(hS s hs).1, (hS s hs).2]
end


import Cat.Fam.HomEq

/-! # Dual of a `Cat`egory -/

namespace Cat

variable
  (ℂ : Cat)

/-- Dual arrow. -/
abbrev Fam.Cat.dualHom
  (α β : ℂ.Obj)
: Setoid :=
  ℂ.Hom β α

/-- Dual composition: actual, non-setoid function. -/
abbrev Fam.Cat.dualKompose
  {α β γ : ℂ.Obj}
  (f : |ℂ.dualHom β γ|)
  (g : |ℂ.dualHom α β|)
: |ℂ.dualHom α γ| :=
  ℂ.compose g f

/-- Dual composition is associative. -/
@[simp]
abbrev Fam.Cat.dualKompose_assoc
  {α β γ δ : ℂ.Obj}
  (f : |ℂ.dualHom γ δ|)
  (g : |ℂ.dualHom β γ|)
  (h : |ℂ.dualHom α β|)
: ℂ.dualKompose f (ℂ.dualKompose g h)
≈ ℂ.dualKompose (ℂ.dualKompose f g) h
:=
  -- symmetric of `ℂ.compose_assoc`
  ℂ.compose_assoc h g f
  |> (ℂ.Hom δ α).symm

/-- Dual composition respects congruence laws. -/
@[simp]
abbrev Fam.Cat.dualCongr
  {α β γ : ℂ.Obj}
: Congr |ℂ.dualHom β γ| |ℂ.dualHom α β| |ℂ.dualHom α γ| ℂ.dualKompose where
  left {_f _f'} g h_f :=
    ℂ.congr.right g h_f
  right f {_g _g'} h_g :=
    ℂ.congr.left f h_g

/-- `Comp` structure for dual composition. -/
@[simp]
abbrev Fam.Cat.dualComp
: Comp ℂ.Obj ℂ.dualHom where
  comp :=
    ℂ.dualKompose
  congr :=
    ℂ.dualCongr

/-- Identity of the dual of a category. -/
@[simp]
abbrev Fam.Cat.dualId
  {α : ℂ.Obj}
: |ℂ.dualHom α α| :=
  ℂ.id

/-- Identity of the dual of a category, type-explicit version. -/
@[simp]
abbrev Fam.Cat.dualId'
  (α : ℂ.Obj)
: |ℂ.dualHom α α| :=
  ℂ.id

/-- Left-composition by `dualId` is identity. -/
@[simp]
abbrev Fam.Cat.id_dualKompose
  {α β : ℂ.Obj}
  (f : |ℂ.dualHom α β|)
: ℂ.dualKompose ℂ.dualId f ≈ f :=
  ℂ.compose_id f

/-- Right-composition by `dualId` is identity. -/
@[simp]
abbrev Fam.Cat.dualKompose_id
  {α β : ℂ.Obj}
  (f : |ℂ.dualHom α β|)
: ℂ.dualKompose f ℂ.dualId ≈ f :=
  ℂ.id_compose f

/-- Dual of a category `ℂᵒᵖ` (`\op`). -/
def Fam.Cat.Dual : Cat :=
  ℂ.dualComp.toCat
    ℂ.dualKompose_assoc
    ℂ.dualId
    ℂ.id_dualKompose
    ℂ.dualKompose_id

postfix:max "ᵒᵖ" =>
  Fam.Cat.Dual

/-- Double dualification is identity. -/
@[simp]
theorem Fam.Cat.idemDual
  (ℂ : Cat)
: (ℂᵒᵖ)ᵒᵖ = ℂ :=
  rfl


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
Ported by: Scott Morrison

! This file was ported from Lean 3 source module data.int.cast.lemmas
! leanprover-community/mathlib commit acebd8d49928f6ed8920e502a6c90674e75bd441
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Order.Basic
import Mathlib.Data.Nat.Cast.Basic

/-!
# Cast of integers (additional theorems)

This file proves additional properties about the *canonical* homomorphism from
the integers into an additive group with a one (`Int.cast`),
particularly results involving algebraic homomorphisms or the order structure on `ℤ`
which were not available in the import dependencies of `Data.Int.Cast.Basic`.

## Main declarations

* `castAddHom`: `cast` bundled as an `AddMonoidHom`.
* `castRingHom`: `cast` bundled as a `RingHom`.
-/

open Nat

variable {F ι α β : Type _}

namespace Int

/-- Coercion `ℕ → ℤ` as a `RingHom`. -/
def ofNatHom : ℕ →+* ℤ :=
  Nat.castRingHom ℤ
#align int.of_nat_hom Int.ofNatHom

-- Porting note: no need to be `@[simp]`, as `Nat.cast_pos` handles this.
-- @[simp]
theorem coe_nat_pos {n : ℕ} : (0 : ℤ) < n ↔ 0 < n :=
  Nat.cast_pos
#align int.coe_nat_pos Int.coe_nat_pos

theorem coe_nat_succ_pos (n : ℕ) : 0 < (n.succ : ℤ) :=
  Int.coe_nat_pos.2 (succ_pos n)
#align int.coe_nat_succ_pos Int.coe_nat_succ_pos

lemma toNat_lt' {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.toNat < b ↔ a < b := by
  rw [←toNat_lt_toNat, toNat_coe_nat]; exact coe_nat_pos.2 hb.bot_lt
#align int.to_nat_lt Int.toNat_lt'

lemma natMod_lt {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.natMod b < b :=
(toNat_lt' hb).2 $ emod_lt_of_pos _ $ coe_nat_pos.2 hb.bot_lt
#align int.nat_mod_lt Int.natMod_lt

section cast

@[simp, norm_cast]
theorem cast_mul [NonAssocRing α] : ∀ m n, ((m * n : ℤ) : α) = m * n := fun m =>
  Int.inductionOn' m 0 (by simp) (fun k _ ih n => by simp [add_mul, ih]) fun k _ ih n => by
    simp [sub_mul, ih]
#align int.cast_mul Int.cast_mulₓ -- dubious translation, type involves HasLiftT

@[simp, norm_cast]
theorem cast_ite [AddGroupWithOne α] (P : Prop) [Decidable P] (m n : ℤ) :
    ((ite P m n : ℤ) : α) = ite P (m : α) (n : α) :=
  apply_ite _ _ _ _
#align int.cast_ite Int.cast_ite

/-- `coe : ℤ → α` as an `AddMonoidHom`. -/
def castAddHom (α : Type _) [AddGroupWithOne α] : ℤ →+ α where
  toFun := Int.cast
  map_zero' := cast_zero
  map_add' := cast_add
#align int.cast_add_hom Int.castAddHom

@[simp]
theorem coe_castAddHom [AddGroupWithOne α] : ⇑(castAddHom α) = fun x : ℤ => (x : α) :=
  rfl
#align int.coe_cast_add_hom Int.coe_castAddHom

/-- `coe : ℤ → α` as a `RingHom`. -/
def castRingHom (α : Type _) [NonAssocRing α] : ℤ →+* α where
  toFun := Int.cast
  map_zero' := cast_zero
  map_add' := cast_add
  map_one' := cast_one
  map_mul' := cast_mul
#align int.cast_ring_hom Int.castRingHom

@[simp]
theorem coe_castRingHom [NonAssocRing α] : ⇑(castRingHom α) = fun x : ℤ => (x : α) :=
  rfl
#align int.coe_cast_ring_hom Int.coe_castRingHom

theorem cast_commute [NonAssocRing α] : ∀ (m : ℤ) (x : α), Commute (↑m) x
  | (n : ℕ), x => by simpa using n.cast_commute x
  | -[n+1], x => by
    simpa only [cast_negSucc, Commute.neg_left_iff, Commute.neg_right_iff] using
      (n + 1).cast_commute (-x)
#align int.cast_commute Int.cast_commute

theorem cast_comm [NonAssocRing α] (m : ℤ) (x : α) : (m : α) * x = x * m :=
  (cast_commute m x).eq
#align int.cast_comm Int.cast_comm

theorem commute_cast [NonAssocRing α] (x : α) (m : ℤ) : Commute x m :=
  (m.cast_commute x).symm
#align int.commute_cast Int.commute_cast

theorem cast_mono [OrderedRing α] : Monotone (fun x : ℤ => (x : α)) := by
  intro m n h
  rw [← sub_nonneg] at h
  lift n - m to ℕ using h with k hk
  rw [← sub_nonneg, ← cast_sub, ← hk, cast_ofNat]
  exact k.cast_nonneg
#align int.cast_mono Int.cast_mono

@[simp]
theorem cast_nonneg [OrderedRing α] [Nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n
  | (n : ℕ) => by simp
  | -[n+1] => by
    have : -(n : α) < 1 := lt_of_le_of_lt (by simp) zero_lt_one
    simpa [(negSucc_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le
#align int.cast_nonneg Int.cast_nonneg

@[simp, norm_cast]
theorem cast_le [OrderedRing α] [Nontrivial α] {m n : ℤ} : (m : α) ≤ n ↔ m ≤ n := by
  rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]
#align int.cast_le Int.cast_le

theorem cast_strictMono [OrderedRing α] [Nontrivial α] : StrictMono (fun x : ℤ => (x : α)) :=
  strictMono_of_le_iff_le fun _ _ => cast_le.symm
#align int.cast_strict_mono Int.cast_strictMono

@[simp, norm_cast]
theorem cast_lt [OrderedRing α] [Nontrivial α] {m n : ℤ} : (m : α) < n ↔ m < n :=
  cast_strictMono.lt_iff_lt
#align int.cast_lt Int.cast_lt

@[simp]
theorem cast_nonpos [OrderedRing α] [Nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 := by
  rw [← cast_zero, cast_le]
#align int.cast_nonpos Int.cast_nonpos

@[simp]
theorem cast_pos [OrderedRing α] [Nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n := by
  rw [← cast_zero, cast_lt]
#align int.cast_pos Int.cast_pos

@[simp]
theorem cast_lt_zero [OrderedRing α] [Nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 := by
  rw [← cast_zero, cast_lt]
#align int.cast_lt_zero Int.cast_lt_zero

section LinearOrderedRing

variable [LinearOrderedRing α] {a b : ℤ} (n : ℤ)

@[simp, norm_cast]
theorem cast_min : (↑(min a b) : α) = min (a : α) (b : α) :=
  Monotone.map_min cast_mono
#align int.cast_min Int.cast_min

@[simp, norm_cast]
theorem cast_max : (↑(max a b) : α) = max (a : α) (b : α) :=
  Monotone.map_max cast_mono
#align int.cast_max Int.cast_max

@[simp, norm_cast]
theorem cast_abs : ((|a| : ℤ) : α) = |(a : α)| := by simp [abs_eq_max_neg]
#align int.cast_abs Int.cast_abs

theorem cast_one_le_of_pos (h : 0 < a) : (1 : α) ≤ a := by exact_mod_cast Int.add_one_le_of_lt h
#align int.cast_one_le_of_pos Int.cast_one_le_of_pos

theorem cast_le_neg_one_of_neg (h : a < 0) : (a : α) ≤ -1 := by
  rw [← Int.cast_one, ← Int.cast_neg, cast_le]
  exact Int.le_sub_one_of_lt h
#align int.cast_le_neg_one_of_neg Int.cast_le_neg_one_of_neg

variable (α) {n}

theorem cast_le_neg_one_or_one_le_cast_of_ne_zero (hn : n ≠ 0) : (n : α) ≤ -1 ∨ 1 ≤ (n : α) :=
  hn.lt_or_lt.imp cast_le_neg_one_of_neg cast_one_le_of_pos
#align int.cast_le_neg_one_or_one_le_cast_of_ne_zero Int.cast_le_neg_one_or_one_le_cast_of_ne_zero

variable {α} (n)

theorem nneg_mul_add_sq_of_abs_le_one {x : α} (hx : |x| ≤ 1) : (0 : α) ≤ n * x + n * n := by
  have hnx : 0 < n → 0 ≤ x + n := fun hn => by
    have := _root_.add_le_add (neg_le_of_abs_le hx) (cast_one_le_of_pos hn)
    rwa [add_left_neg] at this
  have hnx' : n < 0 → x + n ≤ 0 := fun hn => by
    have := _root_.add_le_add (le_of_abs_le hx) (cast_le_neg_one_of_neg hn)
    rwa [add_right_neg] at this
  rw [← mul_add, mul_nonneg_iff]
  rcases lt_trichotomy n 0 with (h | rfl | h)
  · exact Or.inr ⟨by exact_mod_cast h.le, hnx' h⟩
  · simp [le_total 0 x]
  · exact Or.inl ⟨by exact_mod_cast h.le, hnx h⟩
#align int.nneg_mul_add_sq_of_abs_le_one Int.nneg_mul_add_sq_of_abs_le_one

theorem cast_natAbs : (n.natAbs : α) = |n| := by
  cases n
  · simp
  · rw [abs_eq_natAbs, natAbs_negSucc, cast_succ, cast_ofNat, cast_succ]
#align int.cast_nat_abs Int.cast_natAbs

end LinearOrderedRing

theorem coe_int_dvd [CommRing α] (m n : ℤ) (h : m ∣ n) : (m : α) ∣ (n : α) :=
  RingHom.map_dvd (Int.castRingHom α) h
#align int.coe_int_dvd Int.coe_int_dvd

end cast

end Int

open Int

namespace AddMonoidHom

variable {A : Type _}

/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal
if `f 1 = g 1`. -/
@[ext]
theorem ext_int [AddMonoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g :=
  have : f.comp (Int.ofNatHom : ℕ →+ ℤ) = g.comp (Int.ofNatHom : ℕ →+ ℤ) := ext_nat' _ _ h1
  have this' : ∀ n : ℕ, f n = g n := FunLike.ext_iff.1 this
  ext fun n => match n with
  | (n : ℕ) => this' n
  | .negSucc n => eq_on_neg _ _ (this' <| n + 1)
#align add_monoid_hom.ext_int AddMonoidHom.ext_int

variable [AddGroupWithOne A]

theorem eq_int_castAddHom (f : ℤ →+ A) (h1 : f 1 = 1) : f = Int.castAddHom A :=
  ext_int <| by simp [h1]
#align add_monoid_hom.eq_int_cast_hom AddMonoidHom.eq_int_castAddHom

end AddMonoidHom

theorem eq_intCast' [AddGroupWithOne α] [AddMonoidHomClass F ℤ α] (f : F) (h₁ : f 1 = 1) :
    ∀ n : ℤ, f n = n :=
  FunLike.ext_iff.1 <| (f : ℤ →+ α).eq_int_castAddHom h₁
#align eq_int_cast' eq_intCast'

@[simp]
theorem Int.castAddHom_int : Int.castAddHom ℤ = AddMonoidHom.id ℤ :=
  ((AddMonoidHom.id ℤ).eq_int_castAddHom rfl).symm
#align int.cast_add_hom_int Int.castAddHom_int

namespace MonoidHom

variable {M : Type _} [Monoid M]

open Multiplicative

@[ext]
theorem ext_mint {f g : Multiplicative ℤ →* M} (h1 : f (ofAdd 1) = g (ofAdd 1)) : f = g :=
  MonoidHom.toAdditive''.injective <| AddMonoidHom.ext_int <| Additive.toMul.injective h1
#align monoid_hom.ext_mint MonoidHom.ext_mint

/-- If two `MonoidHom`s agree on `-1` and the naturals then they are equal. -/
@[ext]
theorem ext_int {f g : ℤ →* M} (h_neg_one : f (-1) = g (-1))
    (h_nat : f.comp Int.ofNatHom.toMonoidHom = g.comp Int.ofNatHom.toMonoidHom) : f = g := by
  ext (x | x)
  · exact (FunLike.congr_fun h_nat x : _)
  · rw [Int.negSucc_eq, ← neg_one_mul, f.map_mul, g.map_mul]
    congr 1
    exact_mod_cast (FunLike.congr_fun h_nat (x + 1) : _)
#align monoid_hom.ext_int MonoidHom.ext_int

end MonoidHom

namespace MonoidWithZeroHom

variable {M : Type _} [MonoidWithZero M]

/-- If two `MonoidWithZeroHom`s agree on `-1` and the naturals then they are equal. -/
@[ext]
theorem ext_int {f g : ℤ →*₀ M} (h_neg_one : f (-1) = g (-1))
    (h_nat : f.comp Int.ofNatHom.toMonoidWithZeroHom = g.comp Int.ofNatHom.toMonoidWithZeroHom) :
    f = g :=
  toMonoidHom_injective <| MonoidHom.ext_int h_neg_one <|
    MonoidHom.ext (FunLike.congr_fun h_nat : _)
#align monoid_with_zero_hom.ext_int MonoidWithZeroHom.ext_int

end MonoidWithZeroHom

/-- If two `MonoidWithZeroHom`s agree on `-1` and the _positive_ naturals then they are equal. -/
theorem ext_int' [MonoidWithZero α] [MonoidWithZeroHomClass F ℤ α] {f g : F}
    (h_neg_one : f (-1) = g (-1)) (h_pos : ∀ n : ℕ, 0 < n → f n = g n) : f = g :=
  (FunLike.ext _ _) fun n =>
    haveI :=
      FunLike.congr_fun
        (@MonoidWithZeroHom.ext_int _ _ (f : ℤ →*₀ α) (g : ℤ →*₀ α) h_neg_one <|
          MonoidWithZeroHom.ext_nat (h_pos _))
        n
    this
#align ext_int' ext_int'

section NonAssocRing

variable [NonAssocRing α] [NonAssocRing β]

@[simp]
theorem eq_intCast [RingHomClass F ℤ α] (f : F) (n : ℤ) : f n = n :=
  eq_intCast' f (map_one _) n
#align eq_int_cast eq_intCast

@[simp]
theorem map_intCast [RingHomClass F α β] (f : F) (n : ℤ) : f n = n :=
  eq_intCast ((f : α →+* β).comp (Int.castRingHom α)) n
#align map_int_cast map_intCast

namespace RingHom

theorem eq_intCast' (f : ℤ →+* α) : f = Int.castRingHom α :=
  RingHom.ext <| eq_intCast f
#align ring_hom.eq_int_cast' RingHom.eq_intCast'

theorem ext_int {R : Type _} [NonAssocSemiring R] (f g : ℤ →+* R) : f = g :=
  coe_addMonoidHom_injective <| AddMonoidHom.ext_int <| f.map_one.trans g.map_one.symm
#align ring_hom.ext_int RingHom.ext_int

instance Int.subsingleton_ringHom {R : Type _} [NonAssocSemiring R] : Subsingleton (ℤ →+* R) :=
  ⟨RingHom.ext_int⟩
#align ring_hom.int.subsingleton_ring_hom RingHom.Int.subsingleton_ringHom

end RingHom

end NonAssocRing

#align int.cast_id Int.cast_idₓ -- dubious translation, type involves HasLiftT?

@[simp]
theorem Int.castRingHom_int : Int.castRingHom ℤ = RingHom.id ℤ :=
  (RingHom.id ℤ).eq_intCast'.symm
#align int.cast_ring_hom_int Int.castRingHom_int

namespace Pi

variable {π : ι → Type _} [∀ i, IntCast (π i)]

instance intCast : IntCast (∀ i, π i) :=
  { intCast := fun n _ ↦ n }

theorem int_apply (n : ℤ) (i : ι) : (n : ∀ i, π i) i = n :=
  rfl
#align pi.int_apply Pi.int_apply

@[simp]
theorem coe_int (n : ℤ) : (n : ∀ i, π i) = fun _ => ↑n :=
  rfl
#align pi.coe_int Pi.coe_int

end Pi

theorem Sum.elim_intCast_intCast {α β γ : Type _} [IntCast γ] (n : ℤ) :
    Sum.elim (n : α → γ) (n : β → γ) = n :=
  @Sum.elim_lam_const_lam_const α β γ n
#align sum.elim_int_cast_int_cast Sum.elim_intCast_intCast

/-! ### Order dual -/

open OrderDual

instance [h : IntCast α] : IntCast αᵒᵈ :=
  h

instance [h : AddGroupWithOne α] : AddGroupWithOne αᵒᵈ :=
  h

instance [h : AddCommGroupWithOne α] : AddCommGroupWithOne αᵒᵈ :=
  h

@[simp]
theorem toDual_intCast [IntCast α] (n : ℤ) : toDual (n : α) = n :=
  rfl
#align to_dual_int_cast toDual_intCast

@[simp]
theorem ofDual_intCast [IntCast α] (n : ℤ) : (ofDual n : α) = n :=
  rfl
#align of_dual_int_cast ofDual_intCast

/-! ### Lexicographic order -/

instance [h : IntCast α] : IntCast (Lex α) :=
  h

instance [h : AddGroupWithOne α] : AddGroupWithOne (Lex α) :=
  h

instance [h : AddCommGroupWithOne α] : AddCommGroupWithOne (Lex α) :=
  h

@[simp]
theorem toLex_intCast [IntCast α] (n : ℤ) : toLex (n : α) = n :=
  rfl
#align to_lex_int_cast toLex_intCast

@[simp]
theorem ofLex_intCast [IntCast α] (n : ℤ) : (ofLex n : α) = n :=
  rfl
#align of_lex_int_cast ofLex_intCast


import data.stream.defs
import data.stream.init

import tactic.basic

/-

(Alternate formulation of the kolmogorov_puzzle.lean.)

Puzzle referenced from this tweet: https://twitter.com/sigfpe/status/1474173467016589323

From the book _Out of their Minds: The Lives and Discoveries of 15 Great Computer Scientists_
by Dennis Shasha and Cathy Lazere.

Problem: Suppose each (finite) word is either "decent" or "indecent". Given an infinite
sequence of characters, can you always break it into finite words so that all of them
except perhaps the first one belong to the same class?

Answer: yes.

-/

variable {α : Type}

-- non-empty list of α
inductive word (α : Type) : Type
| base : α → word
| cons : α → word → word

def word_head : word α → α
| (word.base a) := a
| (word.cons a _) := a

def prepend_word : word α → stream α → stream α
| (word.base a) s := a :: s
| (word.cons a as) s := a :: prepend_word as s

/--
 Number of symbols in the word, minus one.
-/
def word_size : word α → ℕ
| (word.base a) := 0
| (word.cons a as) := 1 + word_size as

def append : word α → word α → word α
| (word.base c) b := word.cons c b
| (word.cons c cs) b := (word.cons c (append cs b))

structure accumulator_rest (α : Type) : Type :=
  (word_rest : word α)
  (stream_rest : stream (word α))

structure accumulator (α : Type) : Type :=
  (current : α)
  (rest : accumulator_rest α)

def flatten_step : accumulator_rest α → accumulator α
| ⟨word.base c, ws⟩ := ⟨c, ws.head, ws.tail⟩
| ⟨word.cons c cs, ws⟩ := ⟨c, cs, ws⟩

def flatten_aux (words : stream (word α)) : stream (accumulator α) :=
  stream.corec id
               (λ (acc : accumulator α), flatten_step acc.rest)
               (flatten_step ⟨words.head, words.tail⟩)

def flatten (words : stream (word α)) : stream α :=
  (flatten_aux words).map (λ acc, acc.current)

lemma flatten_cons (w : word α) (words : stream (word α)) :
      flatten (w :: words) = prepend_word w (flatten words) :=
begin
  simp[flatten, flatten_aux, stream.corec],
  rw [stream.map_id, stream.map_id],
  have hwh : (w::words).head = w := rfl,
  have hwt : (w::words).tail = words := rfl,
  rw [hwh, hwt], clear hwh hwt,
  induction w with wz a pw hpw,
  { have h :
       flatten_step {word_rest := word.base wz, stream_rest := words}
      = ⟨wz, words.head, words.tail⟩ := rfl,
    rw[prepend_word, h, stream.iterate_eq, stream.map_cons] },
  { have h : flatten_step {word_rest := word.cons a pw, stream_rest := words}
       = ⟨a, pw, words⟩ := rfl,
    rw[h, prepend_word, ←hpw, stream.iterate_eq, stream.map_cons] },
end

lemma flatten_head (words: stream (word α)) : (flatten words).nth 0 = word_head words.head :=
begin
  rw [flatten, flatten_aux],
  cases words.head with a a as,
  {refl},
  {refl},
end

def prefixes_core (w : word α) (s : stream α) : stream (word α) :=
stream.corec_on (w, s)
  (λ ⟨a, b⟩, a)
  (λ p, match p with (w', s') := ⟨append w' (word.base (s'.head)), s'.tail⟩ end)

/-- Initial segments of a stream -/
def prefixes (s : stream α) : stream (word α) :=
  prefixes_core (word.base s.head) s.tail

def all_prefixes'
  (p : word α → Prop)
  (a : stream α) : Prop :=
stream.all p (prefixes a)

/- takes a word of length n + 1 -/
def take_word : ℕ → stream α → word α
| 0 s := word.base s.head
| (n + 1) s := word.cons s.head (take_word n s.tail)

lemma take_prefix
   (is_decent : word α → Prop)
   (a : stream α)
   (ha : all_prefixes' is_decent a)
   (n : ℕ) : is_decent (take_word n a) :=
begin
  have ht := ha n,
  -- should be straightforward. prove an analog of stream.nth_inits
  sorry
end

structure decent_word (is_decent: word α → Prop) : Type :=
  (w: word α)
  (h : is_decent w)

/-
  accumulator is:
    n, the number of symbols already consumed
    h, a proof that (a.drop n) is prefix-decent
-/
noncomputable def choose_decent_words
    (is_decent : word α → Prop)
    (a : stream α)
    (hinit: all_prefixes' is_decent a)
    (hnot: ∀ (n : ℕ), ∃ (k : ℕ),
            all_prefixes' is_decent (stream.drop (k + 1 + n) a))
     : stream (decent_word is_decent) :=
stream.corec' (λ (acc: psigma (λ (n: ℕ), all_prefixes' is_decent (a.drop n))),
                 let ⟨n,hprev⟩ := acc in
                 let new_word_length := classical.some (hnot n) in
                 let h := (classical.some_spec (hnot n)) in
                 let new_word := take_word new_word_length (a.drop n) in
                 ⟨⟨new_word, take_prefix is_decent _ hprev new_word_length⟩,
                  ⟨new_word_length + 1 + n, h ⟩ ⟩)
               ⟨0, hinit⟩

lemma extract_all_decent
    (is_decent : word α → Prop)
    (s : stream (decent_word is_decent))
    : stream.all is_decent (s.map (λ x, x.w)) :=
begin
  intro n,
  exact (s n).h,
end

structure word_indices :=
  (start : ℕ)
  (size : ℕ) -- word length minus one

lemma unflatten
  (a : stream α)
  (b : stream word_indices)
  (w : stream (word α))
  (hw : ∀ n, take_word (b n).size (a.drop (b n).start) = w n)
  (hn : ∀ n, (b n).start + 1 + (b n).size = (b (n + 1)).start)
  (hz : (b 0).start = 0) :
  a = flatten w :=
begin
/-
  refine stream.coinduction _ _,
  { sorry },
  { intros β fr hfr,
    sorry
  },
-/
  ext,
  induction n with pn hpn,
  { have hw0 := hw 0,
    have hsd : stream.drop 0 a = a := rfl,
    have hnth : w 0 = w.head := rfl,
    rw [hz, hsd, hnth] at hw0,
    rw [flatten_head, ← hw0],
    cases (b 0).size,
    { refl },
    { refl },
  },
  { sorry },
end

lemma flatten_decent_words
    (is_decent : word α → Prop)
    (a : stream α)
    (hinit: all_prefixes' is_decent a)
    (hnot: ∀ (n : ℕ), ∃ (k : ℕ),
            all_prefixes' is_decent (stream.drop (k + 1 + n) a)) :
    a = flatten ((choose_decent_words is_decent a hinit hnot).map (λ x, x.1)) :=
begin
  simp[choose_decent_words, stream.corec', stream.corec, flatten],
  sorry
end

theorem kolmogorov_puzzle
  (is_decent : word α → Prop)
  (a : stream α)
  : (∃ (words : stream (word α)),
     (a = flatten words ∧
      (stream.all is_decent words.tail ∨
       stream.all (λ w, ¬ is_decent w) words.tail))) :=
begin
  let p : Prop :=
     (∃ (n : ℕ), ∀ (k : ℕ), --0 < k →
         ¬ all_prefixes' is_decent (stream.drop (k + n) a)),

  obtain ⟨n, hn⟩ | hnot := classical.em p,
  { sorry },
  { push_neg at hnot,
    sorry
  }
end


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import order.filter.cofinite

/-!
# Basic theory of bornology

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

We develop the basic theory of bornologies. Instead of axiomatizing bounded sets and defining
bornologies in terms of those, we recognize that the cobounded sets form a filter and define a
bornology as a filter of cobounded sets which contains the cofinite filter.  This allows us to make
use of the extensive library for filters, but we also provide the relevant connecting results for
bounded sets.

The specification of a bornology in terms of the cobounded filter is equivalent to the standard
one (e.g., see [Bourbaki, *Topological Vector Spaces*][bourbaki1987], **covering bornology**, now
often called simply **bornology**) in terms of bounded sets (see `bornology.of_bounded`,
`is_bounded.union`, `is_bounded.subset`), except that we do not allow the empty bornology (that is,
we require that *some* set must be bounded; equivalently, `∅` is bounded). In the literature the
cobounded filter is generally referred to as the *filter at infinity*.

## Main definitions

- `bornology α`: a class consisting of `cobounded : filter α` and a proof that this filter
  contains the `cofinite` filter.
- `bornology.is_cobounded`: the predicate that a set is a member of the `cobounded α` filter. For
  `s : set α`, one should prefer `bornology.is_cobounded s` over `s ∈ cobounded α`.
- `bornology.is_bounded`: the predicate that states a set is bounded (i.e., the complement of a
  cobounded set). One should prefer `bornology.is_bounded s` over `sᶜ ∈ cobounded α`.
- `bounded_space α`: a class extending `bornology α` with the condition
  `bornology.is_bounded (set.univ : set α)`

Although use of `cobounded α` is discouraged for indicating the (co)boundedness of individual sets,
it is intended for regular use as a filter on `α`.
-/

open set filter

variables {ι α β : Type*}

/-- A **bornology** on a type `α` is a filter of cobounded sets which contains the cofinite filter.
Such spaces are equivalently specified by their bounded sets, see `bornology.of_bounded`
and `bornology.ext_iff_is_bounded`-/
@[ext]
class bornology (α : Type*) :=
(cobounded [] : filter α)
(le_cofinite [] : cobounded ≤ cofinite)

/-- A constructor for bornologies by specifying the bounded sets,
and showing that they satisfy the appropriate conditions. -/
@[simps]
def bornology.of_bounded {α : Type*} (B : set (set α))
  (empty_mem : ∅ ∈ B) (subset_mem : ∀ s₁ ∈ B, ∀ s₂ : set α, s₂ ⊆ s₁ → s₂ ∈ B)
  (union_mem : ∀ s₁ s₂ ∈ B, s₁ ∪ s₂ ∈ B) (singleton_mem : ∀ x, {x} ∈ B) :
  bornology α :=
{ cobounded :=
  { sets := {s : set α | sᶜ ∈ B},
    univ_sets := by rwa ←compl_univ at empty_mem,
    sets_of_superset := λ x y hx hy, subset_mem xᶜ hx yᶜ (compl_subset_compl.mpr hy),
    inter_sets := λ x y hx hy, by simpa [compl_inter] using union_mem xᶜ hx yᶜ hy, },
  le_cofinite :=
  begin
    rw le_cofinite_iff_compl_singleton_mem,
    intros x,
    change {x}ᶜᶜ ∈ B,
    rw compl_compl,
    exact singleton_mem x
  end }

/-- A constructor for bornologies by specifying the bounded sets,
and showing that they satisfy the appropriate conditions. -/
@[simps]
def bornology.of_bounded' {α : Type*} (B : set (set α))
  (empty_mem : ∅ ∈ B) (subset_mem : ∀ s₁ ∈ B, ∀ s₂ : set α, s₂ ⊆ s₁ → s₂ ∈ B)
  (union_mem : ∀ s₁ s₂ ∈ B, s₁ ∪ s₂ ∈ B) (sUnion_univ : ⋃₀ B = univ) :
  bornology α :=
bornology.of_bounded B empty_mem subset_mem union_mem $ λ x,
  begin
    rw sUnion_eq_univ_iff at sUnion_univ,
    rcases sUnion_univ x with ⟨s, hs, hxs⟩,
    exact subset_mem s hs {x} (singleton_subset_iff.mpr hxs)
  end

namespace bornology

section
variables [bornology α] {s t : set α} {x : α}

/-- `is_cobounded` is the predicate that `s` is in the filter of cobounded sets in the ambient
bornology on `α` -/
def is_cobounded (s : set α) : Prop := s ∈ cobounded α

/-- `is_bounded` is the predicate that `s` is bounded relative to the ambient bornology on `α`. -/
def is_bounded (s : set α) : Prop := is_cobounded sᶜ

lemma is_cobounded_def {s : set α} : is_cobounded s ↔ s ∈ cobounded α := iff.rfl

lemma is_bounded_def {s : set α} : is_bounded s ↔ sᶜ ∈ cobounded α := iff.rfl

@[simp] lemma is_bounded_compl_iff : is_bounded sᶜ ↔ is_cobounded s :=
by rw [is_bounded_def, is_cobounded_def, compl_compl]

@[simp] lemma is_cobounded_compl_iff : is_cobounded sᶜ ↔ is_bounded s := iff.rfl

alias is_bounded_compl_iff ↔ is_bounded.of_compl is_cobounded.compl
alias is_cobounded_compl_iff ↔ is_cobounded.of_compl is_bounded.compl

@[simp] lemma is_bounded_empty : is_bounded (∅ : set α) :=
by { rw [is_bounded_def, compl_empty], exact univ_mem}

@[simp] lemma is_bounded_singleton : is_bounded ({x} : set α) :=
by {rw [is_bounded_def], exact le_cofinite _ (finite_singleton x).compl_mem_cofinite}

@[simp]

@[simp] lemma is_cobounded_inter : is_cobounded (s ∩ t) ↔ is_cobounded s ∧ is_cobounded t :=
inter_mem_iff

lemma is_cobounded.inter (hs : is_cobounded s) (ht : is_cobounded t) : is_cobounded (s ∩ t) :=
is_cobounded_inter.2 ⟨hs, ht⟩

@[simp] lemma is_bounded_union : is_bounded (s ∪ t) ↔ is_bounded s ∧ is_bounded t :=
by simp only [← is_cobounded_compl_iff, compl_union, is_cobounded_inter]

lemma is_bounded.union (hs : is_bounded s) (ht : is_bounded t) : is_bounded (s ∪ t) :=
is_bounded_union.2 ⟨hs, ht⟩

lemma is_cobounded.superset (hs : is_cobounded s) (ht : s ⊆ t) : is_cobounded t :=
mem_of_superset hs ht

lemma is_bounded.subset (ht : is_bounded t) (hs : s ⊆ t) : is_bounded s :=
ht.superset (compl_subset_compl.mpr hs)

@[simp]
lemma sUnion_bounded_univ : (⋃₀ {s : set α | is_bounded s}) = univ :=
sUnion_eq_univ_iff.2 $ λ a, ⟨{a}, is_bounded_singleton, mem_singleton a⟩

lemma comap_cobounded_le_iff [bornology β] {f : α → β} :
  (cobounded β).comap f ≤ cobounded α ↔ ∀ ⦃s⦄, is_bounded s → is_bounded (f '' s) :=
begin
  refine ⟨λ h s hs, _, λ h t ht,
    ⟨(f '' tᶜ)ᶜ, h $ is_cobounded.compl ht, compl_subset_comm.1 $ subset_preimage_image _ _⟩⟩,
  obtain ⟨t, ht, hts⟩ := h hs.compl,
  rw [subset_compl_comm, ←preimage_compl] at hts,
  exact (is_cobounded.compl ht).subset ((image_subset f hts).trans $ image_preimage_subset _ _),
end

end

lemma ext_iff' {t t' : bornology α} :
  t = t' ↔ ∀ s, (@cobounded α t).sets s ↔ (@cobounded α t').sets s :=
(ext_iff _ _).trans filter.ext_iff

lemma ext_iff_is_bounded {t t' : bornology α} :
  t = t' ↔ ∀ s, @is_bounded α t s ↔ @is_bounded α t' s :=
⟨λ h s, h ▸ iff.rfl, λ h, by { ext, simpa only [is_bounded_def, compl_compl] using h sᶜ, }⟩

variables {s : set α}

lemma is_cobounded_of_bounded_iff (B : set (set α)) {empty_mem subset_mem union_mem sUnion_univ} :
  @is_cobounded _ (of_bounded B empty_mem subset_mem union_mem sUnion_univ) s ↔ sᶜ ∈ B := iff.rfl

lemma is_bounded_of_bounded_iff (B : set (set α)) {empty_mem subset_mem union_mem sUnion_univ} :
  @is_bounded _ (of_bounded B empty_mem subset_mem union_mem sUnion_univ) s ↔ s ∈ B :=
by rw [is_bounded_def, ←filter.mem_sets, of_bounded_cobounded_sets, set.mem_set_of_eq, compl_compl]

variables [bornology α]

lemma is_cobounded_bInter {s : set ι} {f : ι → set α} (hs : s.finite) :
  is_cobounded (⋂ i ∈ s, f i) ↔ ∀ i ∈ s, is_cobounded (f i) :=
bInter_mem hs

@[simp] lemma is_cobounded_bInter_finset (s : finset ι) {f : ι → set α} :
  is_cobounded (⋂ i ∈ s, f i) ↔ ∀ i ∈ s, is_cobounded (f i) :=
bInter_finset_mem s

@[simp] lemma is_cobounded_Inter [finite ι] {f : ι → set α} :
  is_cobounded (⋂ i, f i) ↔ ∀ i, is_cobounded (f i) :=
Inter_mem

lemma is_cobounded_sInter {S : set (set α)} (hs : S.finite) :
  is_cobounded (⋂₀ S) ↔ ∀ s ∈ S, is_cobounded s :=
sInter_mem hs

lemma is_bounded_bUnion {s : set ι} {f : ι → set α} (hs : s.finite) :
  is_bounded (⋃ i ∈ s, f i) ↔ ∀ i ∈ s, is_bounded (f i) :=
by simp only [← is_cobounded_compl_iff, compl_Union, is_cobounded_bInter hs]

lemma is_bounded_bUnion_finset (s : finset ι) {f : ι → set α} :
  is_bounded (⋃ i ∈ s, f i) ↔ ∀ i ∈ s, is_bounded (f i) :=
is_bounded_bUnion s.finite_to_set

lemma is_bounded_sUnion {S : set (set α)} (hs : S.finite) :
  is_bounded (⋃₀ S) ↔ (∀ s ∈ S, is_bounded s) :=
by rw [sUnion_eq_bUnion, is_bounded_bUnion hs]

@[simp] lemma is_bounded_Union [finite ι] {s : ι → set α} :
  is_bounded (⋃ i, s i) ↔ ∀ i, is_bounded (s i) :=
by rw [← sUnion_range, is_bounded_sUnion (finite_range s), forall_range_iff]

end bornology

open bornology

lemma set.finite.is_bounded [bornology α] {s : set α} (hs : s.finite) : is_bounded s :=
bornology.le_cofinite α hs.compl_mem_cofinite

instance : bornology punit := ⟨⊥, bot_le⟩

/-- The cofinite filter as a bornology -/
@[reducible] def bornology.cofinite : bornology α :=
{ cobounded := cofinite,
  le_cofinite := le_rfl }

/-- A space with a `bornology` is a **bounded space** if `set.univ : set α` is bounded. -/
class bounded_space (α : Type*) [bornology α] : Prop :=
(bounded_univ : bornology.is_bounded (univ : set α))

namespace bornology

variables [bornology α]

lemma is_bounded_univ : is_bounded (univ : set α) ↔ bounded_space α :=
⟨λ h, ⟨h⟩, λ h, h.1⟩

lemma cobounded_eq_bot_iff : cobounded α = ⊥ ↔ bounded_space α :=
by rw [← is_bounded_univ, is_bounded_def, compl_univ, empty_mem_iff_bot]

variables [bounded_space α]

lemma is_bounded.all (s : set α) : is_bounded s := bounded_space.bounded_univ.subset s.subset_univ
lemma is_cobounded.all (s : set α) : is_cobounded s := compl_compl s ▸ is_bounded.all sᶜ

variable (α)

@[simp] lemma cobounded_eq_bot : cobounded α = ⊥ := cobounded_eq_bot_iff.2 ‹_›

end bornology


/-
Copyright (c) 2022 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne

! This file was ported from Lean 3 source module order.succ_pred.linear_locally_finite
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.LocallyFinite
import Mathbin.Order.SuccPred.Basic
import Mathbin.Order.Hom.Basic
import Mathbin.Data.Countable.Basic
import Mathbin.Logic.Encodable.Basic

/-!
# Linear locally finite orders

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

We prove that a `linear_order` which is a `locally_finite_order` also verifies
* `succ_order`
* `pred_order`
* `is_succ_archimedean`
* `is_pred_archimedean`
* `countable`

Furthermore, we show that there is an `order_iso` between such an order and a subset of `ℤ`.

## Main definitions

* `to_Z i0 i`: in a linear order on which we can define predecessors and successors and which is
  succ-archimedean, we can assign a unique integer `to_Z i0 i` to each element `i : ι` while
  respecting the order, starting from `to_Z i0 i0 = 0`.

## Main results

Instances about linear locally finite orders:
* `linear_locally_finite_order.succ_order`: a linear locally finite order has a successor function.
* `linear_locally_finite_order.pred_order`: a linear locally finite order has a predecessor
  function.
* `linear_locally_finite_order.is_succ_archimedean`: a linear locally finite order is
  succ-archimedean.
* `linear_order.pred_archimedean_of_succ_archimedean`: a succ-archimedean linear order is also
  pred-archimedean.
* `countable_of_linear_succ_pred_arch` : a succ-archimedean linear order is countable.

About `to_Z`:
* `order_iso_range_to_Z_of_linear_succ_pred_arch`: `to_Z` defines an `order_iso` between `ι` and its
  range.
* `order_iso_nat_of_linear_succ_pred_arch`: if the order has a bot but no top, `to_Z` defines an
  `order_iso` between `ι` and `ℕ`.
* `order_iso_int_of_linear_succ_pred_arch`: if the order has neither bot nor top, `to_Z` defines an
  `order_iso` between `ι` and `ℤ`.
* `order_iso_range_of_linear_succ_pred_arch`: if the order has both a bot and a top, `to_Z` gives an
  `order_iso` between `ι` and `finset.range ((to_Z ⊥ ⊤).to_nat + 1)`.

-/

open Order

variable {ι : Type _} [LinearOrder ι]

namespace LinearLocallyFiniteOrder

#print LinearLocallyFiniteOrder.succFn /-
/-- Successor in a linear order. This defines a true successor only when `i` is isolated from above,
i.e. when `i` is not the greatest lower bound of `(i, ∞)`. -/
noncomputable def succFn (i : ι) : ι :=
  (exists_glb_Ioi i).some
#align linear_locally_finite_order.succ_fn LinearLocallyFiniteOrder.succFn
-/

#print LinearLocallyFiniteOrder.succFn_spec /-
theorem succFn_spec (i : ι) : IsGLB (Set.Ioi i) (succFn i) :=
  (exists_glb_Ioi i).choose_spec
#align linear_locally_finite_order.succ_fn_spec LinearLocallyFiniteOrder.succFn_spec
-/

#print LinearLocallyFiniteOrder.le_succFn /-
theorem le_succFn (i : ι) : i ≤ succFn i :=
  by
  rw [le_isGLB_iff (succ_fn_spec i), mem_lowerBounds]
  exact fun x hx => le_of_lt hx
#align linear_locally_finite_order.le_succ_fn LinearLocallyFiniteOrder.le_succFn
-/

#print LinearLocallyFiniteOrder.isGLB_Ioc_of_isGLB_Ioi /-
theorem isGLB_Ioc_of_isGLB_Ioi {i j k : ι} (hij_lt : i < j) (h : IsGLB (Set.Ioi i) k) :
    IsGLB (Set.Ioc i j) k :=
  by
  simp_rw [IsGLB, IsGreatest, mem_upperBounds, mem_lowerBounds] at h⊢
  refine' ⟨fun x hx => h.1 x hx.1, fun x hx => h.2 x _⟩
  intro y hy
  cases' le_or_lt y j with h_le h_lt
  · exact hx y ⟨hy, h_le⟩
  · exact le_trans (hx j ⟨hij_lt, le_rfl⟩) h_lt.le
#align linear_locally_finite_order.is_glb_Ioc_of_is_glb_Ioi LinearLocallyFiniteOrder.isGLB_Ioc_of_isGLB_Ioi
-/

#print LinearLocallyFiniteOrder.isMax_of_succFn_le /-
theorem isMax_of_succFn_le [LocallyFiniteOrder ι] (i : ι) (hi : succFn i ≤ i) : IsMax i :=
  by
  refine' fun j hij => not_lt.mp fun hij_lt => _
  have h_succ_fn_eq : succ_fn i = i := le_antisymm hi (le_succ_fn i)
  have h_glb : IsGLB (Finset.Ioc i j : Set ι) i :=
    by
    rw [Finset.coe_Ioc]
    have h := succ_fn_spec i
    rw [h_succ_fn_eq] at h
    exact is_glb_Ioc_of_is_glb_Ioi hij_lt h
  have hi_mem : i ∈ Finset.Ioc i j :=
    by
    refine' Finset.is_glb_mem _ h_glb _
    exact ⟨_, finset.mem_Ioc.mpr ⟨hij_lt, le_rfl⟩⟩
  rw [Finset.mem_Ioc] at hi_mem
  exact lt_irrefl i hi_mem.1
#align linear_locally_finite_order.is_max_of_succ_fn_le LinearLocallyFiniteOrder.isMax_of_succFn_le
-/

#print LinearLocallyFiniteOrder.succFn_le_of_lt /-
theorem succFn_le_of_lt (i j : ι) (hij : i < j) : succFn i ≤ j :=
  by
  have h := succ_fn_spec i
  rw [IsGLB, IsGreatest, mem_lowerBounds] at h
  exact h.1 j hij
#align linear_locally_finite_order.succ_fn_le_of_lt LinearLocallyFiniteOrder.succFn_le_of_lt
-/

#print LinearLocallyFiniteOrder.le_of_lt_succFn /-
theorem le_of_lt_succFn (j i : ι) (hij : j < succFn i) : j ≤ i :=
  by
  rw [lt_isGLB_iff (succ_fn_spec i)] at hij
  obtain ⟨k, hk_lb, hk⟩ := hij
  rw [mem_lowerBounds] at hk_lb
  exact not_lt.mp fun hi_lt_j => not_le.mpr hk (hk_lb j hi_lt_j)
#align linear_locally_finite_order.le_of_lt_succ_fn LinearLocallyFiniteOrder.le_of_lt_succFn
-/

noncomputable instance (priority := 100) [LocallyFiniteOrder ι] : SuccOrder ι
    where
  succ := succFn
  le_succ := le_succFn
  max_of_succ_le := isMax_of_succFn_le
  succ_le_of_lt := succFn_le_of_lt
  le_of_lt_succ := le_of_lt_succFn

noncomputable instance (priority := 100) [LocallyFiniteOrder ι] : PredOrder ι :=
  @OrderDual.predOrder ιᵒᵈ _ _

end LinearLocallyFiniteOrder

#print LinearLocallyFiniteOrder.isSuccArchimedean /-
instance (priority := 100) LinearLocallyFiniteOrder.isSuccArchimedean [LocallyFiniteOrder ι] :
    IsSuccArchimedean ι
    where exists_succ_iterate_of_le i j hij :=
    by
    rw [le_iff_lt_or_eq] at hij
    cases hij
    swap
    · refine' ⟨0, _⟩
      simpa only [Function.iterate_zero, id.def] using hij
    by_contra h
    push_neg  at h
    have h_lt : ∀ n, (succ^[n]) i < j := by
      intro n
      induction' n with n hn
      · simpa only [Function.iterate_zero, id.def] using hij
      · refine' lt_of_le_of_ne _ (h _)
        rw [Function.iterate_succ', Function.comp_apply]
        exact succ_le_of_lt hn
    have h_mem : ∀ n, (succ^[n]) i ∈ Finset.Icc i j := fun n =>
      finset.mem_Icc.mpr ⟨le_succ_iterate n i, (h_lt n).le⟩
    obtain ⟨n, m, hnm, h_eq⟩ : ∃ n m, n < m ∧ (succ^[n]) i = (succ^[m]) i :=
      by
      let f : ℕ → Finset.Icc i j := fun n => ⟨(succ^[n]) i, h_mem n⟩
      obtain ⟨n, m, hnm_ne, hfnm⟩ : ∃ n m, n ≠ m ∧ f n = f m
      exact Finite.exists_ne_map_eq_of_infinite f
      have hnm_eq : (succ^[n]) i = (succ^[m]) i := by simpa only [Subtype.mk_eq_mk] using hfnm
      cases' le_total n m with h_le h_le
      · exact ⟨n, m, lt_of_le_of_ne h_le hnm_ne, hnm_eq⟩
      · exact ⟨m, n, lt_of_le_of_ne h_le hnm_ne.symm, hnm_eq.symm⟩
    have h_max : IsMax ((succ^[n]) i) := is_max_iterate_succ_of_eq_of_ne h_eq hnm.ne
    exact not_le.mpr (h_lt n) (h_max (h_lt n).le)
#align linear_locally_finite_order.is_succ_archimedean LinearLocallyFiniteOrder.isSuccArchimedean
-/

#print LinearOrder.isPredArchimedean_of_isSuccArchimedean /-
instance (priority := 100) LinearOrder.isPredArchimedean_of_isSuccArchimedean [SuccOrder ι]
    [PredOrder ι] [IsSuccArchimedean ι] : IsPredArchimedean ι
    where exists_pred_iterate_of_le i j hij :=
    by
    have h_exists := exists_succ_iterate_of_le hij
    obtain ⟨n, hn_eq, hn_lt_ne⟩ : ∃ n, (succ^[n]) i = j ∧ ∀ m < n, (succ^[m]) i ≠ j
    exact ⟨Nat.find h_exists, Nat.find_spec h_exists, fun m hmn => Nat.find_min h_exists hmn⟩
    refine' ⟨n, _⟩
    rw [← hn_eq]
    induction' n with n hn
    · simp only [Function.iterate_zero, id.def]
    · rw [pred_succ_iterate_of_not_is_max]
      rw [Nat.succ_sub_succ_eq_sub, tsub_zero]
      suffices : (succ^[n]) i < (succ^[n.succ]) i
      exact not_isMax_of_lt this
      refine' lt_of_le_of_ne _ _
      · rw [Function.iterate_succ']
        exact le_succ _
      · rw [hn_eq]
        exact hn_lt_ne _ (Nat.lt_succ_self n)
#align linear_order.pred_archimedean_of_succ_archimedean LinearOrder.isPredArchimedean_of_isSuccArchimedean
-/

section toZ

variable [SuccOrder ι] [IsSuccArchimedean ι] [PredOrder ι] {i0 i : ι}

#print toZ /-
/-- `to_Z` numbers elements of `ι` according to their order, starting from `i0`. We prove in
`order_iso_range_to_Z_of_linear_succ_pred_arch` that this defines an `order_iso` between `ι` and
the range of `to_Z`. -/
def toZ (i0 i : ι) : ℤ :=
  dite (i0 ≤ i) (fun hi => Nat.find (exists_succ_iterate_of_le hi)) fun hi =>
    -Nat.find (exists_pred_iterate_of_le (not_le.mp hi).le)
#align to_Z toZ
-/

/- warning: to_Z_of_ge -> toZ_of_ge is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] [_inst_3 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2] [_inst_4 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] {i0 : ι} {i : ι} (hi : LE.le.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) i0 i), Eq.{1} Int (toZ.{u1} ι _inst_1 _inst_2 _inst_3 _inst_4 i0 i) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) (Nat.find (fun (n : Nat) => Eq.{succ u1} ι (Nat.iterate.{succ u1} ι (Order.succ.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2) n i0) i) (fun (a : Nat) => Eq.decidable.{u1} ι _inst_1 (Nat.iterate.{succ u1} ι (Order.succ.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2) a i0) i) (IsSuccArchimedean.exists_succ_iterate_of_le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2 _inst_3 i0 i hi)))
but is expected to have type
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] [_inst_3 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2] [_inst_4 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] {i0 : ι} {i : ι} (hi : LE.le.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) i0 i), Eq.{1} Int (toZ.{u1} ι _inst_1 _inst_2 _inst_3 _inst_4 i0 i) (Nat.cast.{0} Int instNatCastInt (Nat.find (fun (n : Nat) => Eq.{succ u1} ι (Nat.iterate.{succ u1} ι (Order.succ.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2) n i0) i) (fun (a : Nat) => instDecidableEq.{u1} ι _inst_1 (Nat.iterate.{succ u1} ι (Order.succ.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2) a i0) i) (IsSuccArchimedean.exists_succ_iterate_of_le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2 _inst_3 i0 i hi)))
Case conversion may be inaccurate. Consider using '#align to_Z_of_ge toZ_of_geₓ'. -/
theorem toZ_of_ge (hi : i0 ≤ i) : toZ i0 i = Nat.find (exists_succ_iterate_of_le hi) :=
  dif_pos hi
#align to_Z_of_ge toZ_of_ge

/- warning: to_Z_of_lt -> toZ_of_lt is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] [_inst_3 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2] [_inst_4 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] {i0 : ι} {i : ι} (hi : LT.lt.{u1} ι (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) i i0), Eq.{1} Int (toZ.{u1} ι _inst_1 _inst_2 _inst_3 _inst_4 i0 i) (Neg.neg.{0} Int Int.hasNeg ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) (Nat.find (fun (n : Nat) => Eq.{succ u1} ι (Nat.iterate.{succ u1} ι (Order.pred.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_4) n i0) i) (fun (a : Nat) => Eq.decidable.{u1} ι _inst_1 (Nat.iterate.{succ u1} ι (Order.pred.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_4) a i0) i) (IsPredArchimedean.exists_pred_iterate_of_le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_4 (LinearOrder.isPredArchimedean_of_isSuccArchimedean.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3) i i0 (LT.lt.le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) i i0 hi)))))
but is expected to have type
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] [_inst_3 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2] [_inst_4 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] {i0 : ι} {i : ι} (hi : LT.lt.{u1} ι (Preorder.toLT.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) i i0), Eq.{1} Int (toZ.{u1} ι _inst_1 _inst_2 _inst_3 _inst_4 i0 i) (Neg.neg.{0} Int Int.instNegInt (Nat.cast.{0} Int instNatCastInt (Nat.find (fun (n : Nat) => Eq.{succ u1} ι (Nat.iterate.{succ u1} ι (Order.pred.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_4) n i0) i) (fun (a : Nat) => instDecidableEq.{u1} ι _inst_1 (Nat.iterate.{succ u1} ι (Order.pred.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_4) a i0) i) (IsPredArchimedean.exists_pred_iterate_of_le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_4 (LinearOrder.isPredArchimedean_of_isSuccArchimedean.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3) i i0 (LT.lt.le.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) i i0 hi)))))
Case conversion may be inaccurate. Consider using '#align to_Z_of_lt toZ_of_ltₓ'. -/
theorem toZ_of_lt (hi : i < i0) : toZ i0 i = -Nat.find (exists_pred_iterate_of_le hi.le) :=
  dif_neg (not_le.mpr hi)
#align to_Z_of_lt toZ_of_lt

#print toZ_of_eq /-
@[simp]
theorem toZ_of_eq : toZ i0 i0 = 0 := by
  rw [toZ_of_ge le_rfl]
  norm_cast
  refine' le_antisymm (Nat.find_le _) (zero_le _)
  rw [Function.iterate_zero, id.def]
#align to_Z_of_eq toZ_of_eq
-/

#print iterate_succ_toZ /-
theorem iterate_succ_toZ (i : ι) (hi : i0 ≤ i) : (succ^[(toZ i0 i).toNat]) i0 = i :=
  by
  rw [toZ_of_ge hi, Int.toNat_coe_nat]
  exact Nat.find_spec (exists_succ_iterate_of_le hi)
#align iterate_succ_to_Z iterate_succ_toZ
-/

#print iterate_pred_toZ /-
theorem iterate_pred_toZ (i : ι) (hi : i < i0) : (pred^[(-toZ i0 i).toNat]) i0 = i :=
  by
  rw [toZ_of_lt hi, neg_neg, Int.toNat_coe_nat]
  exact Nat.find_spec (exists_pred_iterate_of_le hi.le)
#align iterate_pred_to_Z iterate_pred_toZ
-/

#print toZ_nonneg /-
theorem toZ_nonneg (hi : i0 ≤ i) : 0 ≤ toZ i0 i :=
  by
  rw [toZ_of_ge hi]
  exact Nat.cast_nonneg _
#align to_Z_nonneg toZ_nonneg
-/

#print toZ_neg /-
theorem toZ_neg (hi : i < i0) : toZ i0 i < 0 :=
  by
  refine' lt_of_le_of_ne _ _
  · rw [toZ_of_lt hi, neg_nonpos]
    exact Nat.cast_nonneg _
  · by_contra
    have h_eq := iterate_pred_toZ i hi
    rw [← h_eq, h] at hi
    simpa only [neg_zero, Int.toNat_zero, Function.iterate_zero, id.def, lt_self_iff_false] using hi
#align to_Z_neg toZ_neg
-/

#print toZ_iterate_succ_le /-
theorem toZ_iterate_succ_le (n : ℕ) : toZ i0 ((succ^[n]) i0) ≤ n :=
  by
  rw [toZ_of_ge (le_succ_iterate _ _)]
  norm_cast
  exact Nat.find_min' (exists_succ_iterate_of_le _) rfl
#align to_Z_iterate_succ_le toZ_iterate_succ_le
-/

#print toZ_iterate_pred_ge /-
theorem toZ_iterate_pred_ge (n : ℕ) : -(n : ℤ) ≤ toZ i0 ((pred^[n]) i0) :=
  by
  cases' le_or_lt i0 ((pred^[n]) i0) with h h
  · have h_eq : (pred^[n]) i0 = i0 := le_antisymm (pred_iterate_le _ _) h
    rw [h_eq, toZ_of_eq]
    simp only [Right.neg_nonpos_iff, Nat.cast_nonneg]
  · rw [toZ_of_lt h, neg_le_neg_iff]
    norm_cast
    exact Nat.find_min' (exists_pred_iterate_of_le _) rfl
#align to_Z_iterate_pred_ge toZ_iterate_pred_ge
-/

#print toZ_iterate_succ_of_not_isMax /-
theorem toZ_iterate_succ_of_not_isMax (n : ℕ) (hn : ¬IsMax ((succ^[n]) i0)) :
    toZ i0 ((succ^[n]) i0) = n :=
  by
  let m := (toZ i0 ((succ^[n]) i0)).toNat
  have h_eq : (succ^[m]) i0 = (succ^[n]) i0 := iterate_succ_toZ _ (le_succ_iterate _ _)
  by_cases hmn : m = n
  · nth_rw 2 [← hmn]
    simp_rw [m]
    rw [Int.toNat_eq_max, toZ_of_ge (le_succ_iterate _ _), max_eq_left]
    exact Nat.cast_nonneg _
  suffices : IsMax ((succ^[n]) i0); exact absurd this hn
  exact is_max_iterate_succ_of_eq_of_ne h_eq.symm (Ne.symm hmn)
#align to_Z_iterate_succ_of_not_is_max toZ_iterate_succ_of_not_isMax
-/

#print toZ_iterate_pred_of_not_isMin /-
theorem toZ_iterate_pred_of_not_isMin (n : ℕ) (hn : ¬IsMin ((pred^[n]) i0)) :
    toZ i0 ((pred^[n]) i0) = -n := by
  cases n
  · simp only [Function.iterate_zero, id.def, toZ_of_eq, Nat.cast_zero, neg_zero]
  have : (pred^[n.succ]) i0 < i0 :=
    by
    refine' lt_of_le_of_ne (pred_iterate_le _ _) fun h_pred_iterate_eq => hn _
    have h_pred_eq_pred : (pred^[n.succ]) i0 = (pred^[0]) i0 := by
      rwa [Function.iterate_zero, id.def]
    exact is_min_iterate_pred_of_eq_of_ne h_pred_eq_pred (Nat.succ_ne_zero n)
  let m := (-toZ i0 ((pred^[n.succ]) i0)).toNat
  have h_eq : (pred^[m]) i0 = (pred^[n.succ]) i0 := iterate_pred_toZ _ this
  by_cases hmn : m = n.succ
  · nth_rw 2 [← hmn]
    simp_rw [m]
    rw [Int.toNat_eq_max, toZ_of_lt this, max_eq_left, neg_neg]
    rw [neg_neg]
    exact Nat.cast_nonneg _
  · suffices : IsMin ((pred^[n.succ]) i0)
    exact absurd this hn
    exact is_min_iterate_pred_of_eq_of_ne h_eq.symm (Ne.symm hmn)
#align to_Z_iterate_pred_of_not_is_min toZ_iterate_pred_of_not_isMin
-/

#print le_of_toZ_le /-
theorem le_of_toZ_le {j : ι} (h_le : toZ i0 i ≤ toZ i0 j) : i ≤ j :=
  by
  cases' le_or_lt i0 i with hi hi <;> cases' le_or_lt i0 j with hj hj
  · rw [← iterate_succ_toZ i hi, ← iterate_succ_toZ j hj]
    exact Monotone.monotone_iterate_of_le_map succ_mono (le_succ _) (Int.toNat_le_toNat h_le)
  · exact absurd ((toZ_neg hj).trans_le (toZ_nonneg hi)) (not_lt.mpr h_le)
  · exact hi.le.trans hj
  · rw [← iterate_pred_toZ i hi, ← iterate_pred_toZ j hj]
    refine' Monotone.antitone_iterate_of_map_le pred_mono (pred_le _) (Int.toNat_le_toNat _)
    exact neg_le_neg h_le
#align le_of_to_Z_le le_of_toZ_le
-/

#print toZ_mono /-
theorem toZ_mono {i j : ι} (h_le : i ≤ j) : toZ i0 i ≤ toZ i0 j :=
  by
  by_cases hi_max : IsMax i
  · rw [le_antisymm h_le (hi_max h_le)]
  by_cases hj_min : IsMin j
  · rw [le_antisymm h_le (hj_min h_le)]
  cases' le_or_lt i0 i with hi hi <;> cases' le_or_lt i0 j with hj hj
  · let m := Nat.find (exists_succ_iterate_of_le h_le)
    have hm : (succ^[m]) i = j := Nat.find_spec (exists_succ_iterate_of_le h_le)
    have hj_eq : j = (succ^[(toZ i0 i).toNat + m]) i0 :=
      by
      rw [← hm, add_comm]
      nth_rw 1 [← iterate_succ_toZ i hi]
      rw [Function.iterate_add]
    by_contra h
    push_neg  at h
    by_cases hm0 : m = 0
    · rw [hm0, Function.iterate_zero, id.def] at hm
      rw [hm] at h
      exact lt_irrefl _ h
    refine' hi_max (max_of_succ_le (le_trans _ (@le_of_toZ_le _ _ _ _ _ i0 _ _ _)))
    · exact j
    · have h_succ_le : (succ^[(toZ i0 i).toNat + 1]) i0 ≤ j :=
        by
        rw [hj_eq]
        refine' Monotone.monotone_iterate_of_le_map succ_mono (le_succ i0) (add_le_add_left _ _)
        exact nat.one_le_iff_ne_zero.mpr hm0
      rwa [Function.iterate_succ', Function.comp_apply, iterate_succ_toZ i hi] at h_succ_le
    · exact h.le
  · exact absurd h_le (not_le.mpr (hj.trans_le hi))
  · exact (toZ_neg hi).le.trans (toZ_nonneg hj)
  · let m := Nat.find (exists_pred_iterate_of_le h_le)
    have hm : (pred^[m]) j = i := Nat.find_spec (exists_pred_iterate_of_le h_le)
    have hj_eq : i = (pred^[(-toZ i0 j).toNat + m]) i0 :=
      by
      rw [← hm, add_comm]
      nth_rw 1 [← iterate_pred_toZ j hj]
      rw [Function.iterate_add]
    by_contra h
    push_neg  at h
    by_cases hm0 : m = 0
    · rw [hm0, Function.iterate_zero, id.def] at hm
      rw [hm] at h
      exact lt_irrefl _ h
    refine' hj_min (min_of_le_pred _)
    refine' (@le_of_toZ_le _ _ _ _ _ i0 _ _ _).trans _
    · exact i
    · exact h.le
    · have h_le_pred : i ≤ (pred^[(-toZ i0 j).toNat + 1]) i0 :=
        by
        rw [hj_eq]
        refine' Monotone.antitone_iterate_of_map_le pred_mono (pred_le i0) (add_le_add_left _ _)
        exact nat.one_le_iff_ne_zero.mpr hm0
      rwa [Function.iterate_succ', Function.comp_apply, iterate_pred_toZ j hj] at h_le_pred
#align to_Z_mono toZ_mono
-/

#print toZ_le_iff /-
theorem toZ_le_iff (i j : ι) : toZ i0 i ≤ toZ i0 j ↔ i ≤ j :=
  ⟨le_of_toZ_le, toZ_mono⟩
#align to_Z_le_iff toZ_le_iff
-/

#print toZ_iterate_succ /-
theorem toZ_iterate_succ [NoMaxOrder ι] (n : ℕ) : toZ i0 ((succ^[n]) i0) = n :=
  toZ_iterate_succ_of_not_isMax n (not_isMax _)
#align to_Z_iterate_succ toZ_iterate_succ
-/

#print toZ_iterate_pred /-
theorem toZ_iterate_pred [NoMinOrder ι] (n : ℕ) : toZ i0 ((pred^[n]) i0) = -n :=
  toZ_iterate_pred_of_not_isMin n (not_isMin _)
#align to_Z_iterate_pred toZ_iterate_pred
-/

#print injective_toZ /-
theorem injective_toZ : Function.Injective (toZ i0) := fun i j hij =>
  le_antisymm (le_of_toZ_le hij.le) (le_of_toZ_le hij.symm.le)
#align injective_to_Z injective_toZ
-/

end toZ

section OrderIso

variable [SuccOrder ι] [PredOrder ι] [IsSuccArchimedean ι]

#print orderIsoRangeToZOfLinearSuccPredArch /-
/-- `to_Z` defines an `order_iso` between `ι` and its range. -/
noncomputable def orderIsoRangeToZOfLinearSuccPredArch [hι : Nonempty ι] :
    ι ≃o Set.range (toZ hι.some)
    where
  toEquiv := Equiv.ofInjective _ injective_toZ
  map_rel_iff' := toZ_le_iff
#align order_iso_range_to_Z_of_linear_succ_pred_arch orderIsoRangeToZOfLinearSuccPredArch
-/

#print countable_of_linear_succ_pred_arch /-
instance (priority := 100) countable_of_linear_succ_pred_arch : Countable ι :=
  by
  cases' isEmpty_or_nonempty ι with _ hι
  · infer_instance
  · exact Countable.of_equiv _ orderIsoRangeToZOfLinearSuccPredArch.symm.toEquiv
#align countable_of_linear_succ_pred_arch countable_of_linear_succ_pred_arch
-/

#print orderIsoIntOfLinearSuccPredArch /-
/-- If the order has neither bot nor top, `to_Z` defines an `order_iso` between `ι` and `ℤ`. -/
noncomputable def orderIsoIntOfLinearSuccPredArch [NoMaxOrder ι] [NoMinOrder ι] [hι : Nonempty ι] :
    ι ≃o ℤ where
  toFun := toZ hι.some
  invFun n := if 0 ≤ n then (succ^[n.toNat]) hι.some else (pred^[(-n).toNat]) hι.some
  left_inv i := by
    cases' le_or_lt hι.some i with hi hi
    · have h_nonneg : 0 ≤ toZ hι.some i := toZ_nonneg hi
      simp_rw [if_pos h_nonneg]
      exact iterate_succ_toZ i hi
    · have h_neg : toZ hι.some i < 0 := toZ_neg hi
      simp_rw [if_neg (not_le.mpr h_neg)]
      exact iterate_pred_toZ i hi
  right_inv n := by
    cases' le_or_lt 0 n with hn hn
    · simp_rw [if_pos hn]
      rw [toZ_iterate_succ]
      exact Int.toNat_of_nonneg hn
    · simp_rw [if_neg (not_le.mpr hn)]
      rw [toZ_iterate_pred]
      simp only [hn.le, Int.toNat_of_nonneg, Right.nonneg_neg_iff, neg_neg]
  map_rel_iff' := toZ_le_iff
#align order_iso_int_of_linear_succ_pred_arch orderIsoIntOfLinearSuccPredArch
-/

#print orderIsoNatOfLinearSuccPredArch /-
/-- If the order has a bot but no top, `to_Z` defines an `order_iso` between `ι` and `ℕ`. -/
def orderIsoNatOfLinearSuccPredArch [NoMaxOrder ι] [OrderBot ι] : ι ≃o ℕ
    where
  toFun i := (toZ ⊥ i).toNat
  invFun n := (succ^[n]) ⊥
  left_inv i := by
    simp_rw [if_pos (toZ_nonneg bot_le)]
    exact iterate_succ_toZ i bot_le
  right_inv n := by
    simp_rw [if_pos bot_le]
    rw [toZ_iterate_succ]
    exact Int.toNat_coe_nat n
  map_rel_iff' i j := by
    simp only [Equiv.coe_fn_mk, Int.toNat_le]
    rw [← @toZ_le_iff ι _ _ _ _ ⊥, Int.toNat_of_nonneg (toZ_nonneg bot_le)]
#align order_iso_nat_of_linear_succ_pred_arch orderIsoNatOfLinearSuccPredArch
-/

/- warning: order_iso_range_of_linear_succ_pred_arch -> orderIsoRangeOfLinearSuccPredArch is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] [_inst_3 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))] [_inst_4 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))) _inst_2] [_inst_5 : OrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))))] [_inst_6 : OrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1)))))], OrderIso.{u1, 0} ι (coeSort.{1, 2} (Finset.{0} Nat) Type (Finset.hasCoeToSort.{0} Nat) (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Int.toNat (toZ.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3 (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) _inst_5)) (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) _inst_6)))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) (Subtype.hasLe.{0} Nat Nat.hasLe (fun (x : Nat) => Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Int.toNat (toZ.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3 (Bot.bot.{u1} ι (OrderBot.toHasBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) _inst_5)) (Top.top.{u1} ι (OrderTop.toHasTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (LinearOrder.toLattice.{u1} ι _inst_1))))) _inst_6)))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))))
but is expected to have type
  forall {ι : Type.{u1}} [_inst_1 : LinearOrder.{u1} ι] [_inst_2 : SuccOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] [_inst_3 : PredOrder.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))] [_inst_4 : IsSuccArchimedean.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))) _inst_2] [_inst_5 : OrderBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))))] [_inst_6 : OrderTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1))))))], OrderIso.{u1, 0} ι (Subtype.{1} Nat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Int.toNat (toZ.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3 (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) _inst_5)) (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) _inst_6)))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))) (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) (Subtype.le.{0} Nat instLENat (fun (x : Nat) => Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Int.toNat (toZ.{u1} ι _inst_1 _inst_2 _inst_4 _inst_3 (Bot.bot.{u1} ι (OrderBot.toBot.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) _inst_5)) (Top.top.{u1} ι (OrderTop.toTop.{u1} ι (Preorder.toLE.{u1} ι (PartialOrder.toPreorder.{u1} ι (SemilatticeInf.toPartialOrder.{u1} ι (Lattice.toSemilatticeInf.{u1} ι (DistribLattice.toLattice.{u1} ι (instDistribLattice.{u1} ι _inst_1)))))) _inst_6)))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))))
Case conversion may be inaccurate. Consider using '#align order_iso_range_of_linear_succ_pred_arch orderIsoRangeOfLinearSuccPredArchₓ'. -/
/-- If the order has both a bot and a top, `to_Z` gives an `order_iso` between `ι` and
`finset.range n` for some `n`. -/
def orderIsoRangeOfLinearSuccPredArch [OrderBot ι] [OrderTop ι] :
    ι ≃o Finset.range ((toZ ⊥ (⊤ : ι)).toNat + 1)
    where
  toFun i :=
    ⟨(toZ ⊥ i).toNat,
      Finset.mem_range_succ_iff.mpr (Int.toNat_le_toNat ((toZ_le_iff _ _).mpr le_top))⟩
  invFun n := (succ^[n]) ⊥
  left_inv i := iterate_succ_toZ i bot_le
  right_inv n := by
    ext1
    simp only [Subtype.coe_mk]
    refine' le_antisymm _ _
    · rw [Int.toNat_le]
      exact toZ_iterate_succ_le _
    by_cases hn_max : IsMax ((succ^[↑n]) (⊥ : ι))
    · rw [← isTop_iff_isMax, isTop_iff_eq_top] at hn_max
      rw [hn_max]
      exact nat.lt_succ_iff.mp (finset.mem_range.mp n.prop)
    · rw [toZ_iterate_succ_of_not_isMax _ hn_max]
      simp only [Int.toNat_coe_nat]
  map_rel_iff' i j :=
    by
    simp only [Equiv.coe_fn_mk, Subtype.mk_le_mk, Int.toNat_le]
    rw [← @toZ_le_iff ι _ _ _ _ ⊥, Int.toNat_of_nonneg (toZ_nonneg bot_le)]
#align order_iso_range_of_linear_succ_pred_arch orderIsoRangeOfLinearSuccPredArch

end OrderIso


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.cardinal_ordinal
import Mathlib.PostPort

universes u_1 u v u_2

namespace Mathlib

/-!
# Cofinality on ordinals, regular cardinals
-/

namespace order

/-- Cofinality of a reflexive order `≼`. This is the smallest cardinality
  of a subset `S : set α` such that `∀ a, ∃ b ∈ S, a ≼ b`. -/
def cof {α : Type u_1} (r : α → α → Prop) [is_refl α r] : cardinal :=
  cardinal.min sorry fun (S : Subtype fun (S : set α) => ∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), r a b) => cardinal.mk ↥S

theorem cof_le {α : Type u_1} (r : α → α → Prop) [is_refl α r] {S : set α} (h : ∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), r a b) : cof r ≤ cardinal.mk ↥S := sorry

theorem le_cof {α : Type u_1} {r : α → α → Prop} [is_refl α r] (c : cardinal) : c ≤ cof r ↔ ∀ {S : set α}, (∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), r a b) → c ≤ cardinal.mk ↥S := sorry

end order

theorem rel_iso.cof.aux {α : Type u} {β : Type v} {r : α → α → Prop} {s : β → β → Prop} [is_refl α r] [is_refl β s] (f : r ≃r s) : cardinal.lift (order.cof r) ≤ cardinal.lift (order.cof s) := sorry

theorem rel_iso.cof {α : Type u} {β : Type v} {r : α → α → Prop} {s : β → β → Prop} [is_refl α r] [is_refl β s] (f : r ≃r s) : cardinal.lift (order.cof r) = cardinal.lift (order.cof s) :=
  le_antisymm sorry sorry

def strict_order.cof {α : Type u_1} (r : α → α → Prop) [h : is_irrefl α r] : cardinal :=
  order.cof fun (x y : α) => ¬r y x

namespace ordinal

/-- Cofinality of an ordinal. This is the smallest cardinal of a
  subset `S` of the ordinal which is unbounded, in the sense
  `∀ a, ∃ b ∈ S, ¬(b > a)`. It is defined for all ordinals, but
  `cof 0 = 0` and `cof (succ o) = 1`, so it is only really
  interesting on limit ordinals (when it is an infinite cardinal). -/
def cof (o : ordinal) : cardinal :=
  quot.lift_on o (fun (_x : Well_order) => sorry) sorry

theorem cof_type {α : Type u_1} (r : α → α → Prop) [is_well_order α r] : cof (type r) = strict_order.cof r :=
  rfl

theorem le_cof_type {α : Type u_1} {r : α → α → Prop} [is_well_order α r] {c : cardinal} : c ≤ cof (type r) ↔ ∀ (S : set α), (∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), ¬r b a) → c ≤ cardinal.mk ↥S := sorry

theorem cof_type_le {α : Type u_1} {r : α → α → Prop} [is_well_order α r] (S : set α) (h : ∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), ¬r b a) : cof (type r) ≤ cardinal.mk ↥S :=
  iff.mp le_cof_type (le_refl (cof (type r))) S h

theorem lt_cof_type {α : Type u_1} {r : α → α → Prop} [is_well_order α r] (S : set α) (hl : cardinal.mk ↥S < cof (type r)) : ∃ (a : α), ∀ (b : α), b ∈ S → r b a :=
  iff.mp not_forall_not
    fun (h : ∀ (x : α), ¬∀ (b : α), b ∈ S → r b x) => not_le_of_lt hl (cof_type_le S fun (a : α) => iff.mp not_ball (h a))

theorem cof_eq {α : Type u_1} (r : α → α → Prop) [is_well_order α r] : ∃ (S : set α), (∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), ¬r b a) ∧ cardinal.mk ↥S = cof (type r) := sorry

theorem ord_cof_eq {α : Type u_1} (r : α → α → Prop) [is_well_order α r] : ∃ (S : set α), (∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), ¬r b a) ∧ type (subrel r S) = cardinal.ord (cof (type r)) := sorry

theorem lift_cof (o : ordinal) : cardinal.lift (cof o) = cof (lift o) := sorry

theorem cof_le_card (o : ordinal) : cof o ≤ card o := sorry

theorem cof_ord_le (c : cardinal) : cof (cardinal.ord c) ≤ c := sorry

@[simp] theorem cof_zero : cof 0 = 0 := sorry

@[simp] theorem cof_eq_zero {o : ordinal} : cof o = 0 ↔ o = 0 := sorry

@[simp] theorem cof_succ (o : ordinal) : cof (succ o) = 1 := sorry

@[simp] theorem cof_eq_one_iff_is_succ {o : ordinal} : cof o = 1 ↔ ∃ (a : ordinal), o = succ a := sorry

@[simp] theorem cof_add (a : ordinal) (b : ordinal) : b ≠ 0 → cof (a + b) = cof b := sorry

@[simp] theorem cof_cof (o : ordinal) : cof (cardinal.ord (cof o)) = cof o := sorry

theorem omega_le_cof {o : ordinal} : cardinal.omega ≤ cof o ↔ is_limit o := sorry

@[simp] theorem cof_omega : cof omega = cardinal.omega :=
  le_antisymm (eq.mpr (id (Eq._oldrec (Eq.refl (cof omega ≤ cardinal.omega)) (Eq.symm card_omega))) (cof_le_card omega))
    (iff.mpr omega_le_cof omega_is_limit)

theorem cof_eq' {α : Type u_1} (r : α → α → Prop) [is_well_order α r] (h : is_limit (type r)) : ∃ (S : set α), (∀ (a : α), ∃ (b : α), ∃ (H : b ∈ S), r a b) ∧ cardinal.mk ↥S = cof (type r) := sorry

theorem cof_sup_le_lift {ι : Type u_1} (f : ι → ordinal) (H : ∀ (i : ι), f i < sup f) : cof (sup f) ≤ cardinal.lift (cardinal.mk ι) := sorry

theorem cof_sup_le {ι : Type u} (f : ι → ordinal) (H : ∀ (i : ι), f i < sup f) : cof (sup f) ≤ cardinal.mk ι := sorry

theorem cof_bsup_le_lift {o : ordinal} (f : (a : ordinal) → a < o → ordinal) : (∀ (i : ordinal) (h : i < o), f i h < bsup o f) → cof (bsup o f) ≤ cardinal.lift (card o) := sorry

theorem cof_bsup_le {o : ordinal} (f : (a : ordinal) → a < o → ordinal) : (∀ (i : ordinal) (h : i < o), f i h < bsup o f) → cof (bsup o f) ≤ card o := sorry

@[simp] theorem cof_univ : cof univ = cardinal.univ := sorry

theorem sup_lt_ord {ι : Type u} (f : ι → ordinal) {c : ordinal} (H1 : cardinal.mk ι < cof c) (H2 : ∀ (i : ι), f i < c) : sup f < c := sorry

theorem sup_lt {ι : Type u} (f : ι → cardinal) {c : cardinal} (H1 : cardinal.mk ι < cof (cardinal.ord c)) (H2 : ∀ (i : ι), f i < c) : cardinal.sup f < c := sorry

/-- If the union of s is unbounded and s is smaller than the cofinality, then s has an unbounded member -/
theorem unbounded_of_unbounded_sUnion {α : Type u_1} (r : α → α → Prop) [wo : is_well_order α r] {s : set (set α)} (h₁ : unbounded r (⋃₀s)) (h₂ : cardinal.mk ↥s < strict_order.cof r) : ∃ (x : set α), ∃ (H : x ∈ s), unbounded r x := sorry

/-- If the union of s is unbounded and s is smaller than the cofinality, then s has an unbounded member -/
theorem unbounded_of_unbounded_Union {α : Type u} {β : Type u} (r : α → α → Prop) [wo : is_well_order α r] (s : β → set α) (h₁ : unbounded r (set.Union fun (x : β) => s x)) (h₂ : cardinal.mk β < strict_order.cof r) : ∃ (x : β), unbounded r (s x) := sorry

/-- The infinite pigeonhole principle-/
theorem infinite_pigeonhole {β : Type u} {α : Type u} (f : β → α) (h₁ : cardinal.omega ≤ cardinal.mk β) (h₂ : cardinal.mk α < cof (cardinal.ord (cardinal.mk β))) : ∃ (a : α), cardinal.mk ↥(f ⁻¹' singleton a) = cardinal.mk β := sorry

/-- pigeonhole principle for a cardinality below the cardinality of the domain -/
theorem infinite_pigeonhole_card {β : Type u} {α : Type u} (f : β → α) (θ : cardinal) (hθ : θ ≤ cardinal.mk β) (h₁ : cardinal.omega ≤ θ) (h₂ : cardinal.mk α < cof (cardinal.ord θ)) : ∃ (a : α), θ ≤ cardinal.mk ↥(f ⁻¹' singleton a) := sorry

theorem infinite_pigeonhole_set {β : Type u} {α : Type u} {s : set β} (f : ↥s → α) (θ : cardinal) (hθ : θ ≤ cardinal.mk ↥s) (h₁ : cardinal.omega ≤ θ) (h₂ : cardinal.mk α < cof (cardinal.ord θ)) : ∃ (a : α),
  ∃ (t : set β), ∃ (h : t ⊆ s), θ ≤ cardinal.mk ↥t ∧ ∀ {x : β} (hx : x ∈ t), f { val := x, property := h hx } = a := sorry

end ordinal

namespace cardinal

/-- A cardinal is a limit if it is not zero or a successor
  cardinal. Note that `ω` is a limit cardinal by this definition. -/
def is_limit (c : cardinal) :=
  c ≠ 0 ∧ ∀ (x : cardinal), x < c → succ x < c

/-- A cardinal is a strong limit if it is not zero and it is
  closed under powersets. Note that `ω` is a strong limit by this definition. -/
def is_strong_limit (c : cardinal) :=
  c ≠ 0 ∧ ∀ (x : cardinal), x < c → bit0 1 ^ x < c

theorem is_strong_limit.is_limit {c : cardinal} (H : is_strong_limit c) : is_limit c :=
  { left := and.left H,
    right := fun (x : cardinal) (h : x < c) => lt_of_le_of_lt (iff.mpr succ_le (cantor x)) (and.right H x h) }

/-- A cardinal is regular if it is infinite and it equals its own cofinality. -/
def is_regular (c : cardinal) :=
  omega ≤ c ∧ ordinal.cof (ord c) = c

theorem cof_is_regular {o : ordinal} (h : ordinal.is_limit o) : is_regular (ordinal.cof o) :=
  { left := iff.mpr ordinal.omega_le_cof h, right := ordinal.cof_cof o }

theorem omega_is_regular : is_regular omega := sorry

theorem succ_is_regular {c : cardinal} (h : omega ≤ c) : is_regular (succ c) := sorry

theorem sup_lt_ord_of_is_regular {ι : Type u} (f : ι → ordinal) {c : cardinal} (hc : is_regular c) (H1 : mk ι < c) (H2 : ∀ (i : ι), f i < ord c) : ordinal.sup f < ord c :=
  ordinal.sup_lt_ord (fun (i : ι) => f i)
    (eq.mpr (id (Eq._oldrec (Eq.refl (mk ι < ordinal.cof (ord c))) (and.right hc))) H1) H2

theorem sup_lt_of_is_regular {ι : Type u} (f : ι → cardinal) {c : cardinal} (hc : is_regular c) (H1 : mk ι < c) (H2 : ∀ (i : ι), f i < c) : sup f < c :=
  ordinal.sup_lt (fun (i : ι) => f i) (eq.mpr (id (Eq._oldrec (Eq.refl (mk ι < ordinal.cof (ord c))) (and.right hc))) H1)
    H2

theorem sum_lt_of_is_regular {ι : Type u} (f : ι → cardinal) {c : cardinal} (hc : is_regular c) (H1 : mk ι < c) (H2 : ∀ (i : ι), f i < c) : sum f < c :=
  lt_of_le_of_lt (sum_le_sup f) (mul_lt_of_lt (and.left hc) H1 (sup_lt_of_is_regular f hc H1 H2))

/-- A cardinal is inaccessible if it is an
  uncountable regular strong limit cardinal. -/
def is_inaccessible (c : cardinal) :=
  omega < c ∧ is_regular c ∧ is_strong_limit c

theorem is_inaccessible.mk {c : cardinal} (h₁ : omega < c) (h₂ : c ≤ ordinal.cof (ord c)) (h₃ : ∀ (x : cardinal), x < c → bit0 1 ^ x < c) : is_inaccessible c := sorry

/- Lean's foundations prove the existence of ω many inaccessible
   cardinals -/

theorem univ_inaccessible : is_inaccessible univ := sorry

theorem lt_power_cof {c : cardinal} : omega ≤ c → c < c ^ ordinal.cof (ord c) := sorry

theorem lt_cof_power {a : cardinal} {b : cardinal} (ha : omega ≤ a) (b1 : 1 < b) : a < ordinal.cof (ord (b ^ a)) := sorry


/-
Copyright (c) 2018 Mario Carneiro and Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro and Kevin Buzzard
-/
import order.order_iso
import tactic.tidy

import linear_algebra.subtype_module
import linear_algebra.quotient_module
import linear_algebra.prod_module

local attribute [instance] classical.dec
open lattice function set

structure {u v} submodule (α : Type u) (β : Type v) [ring α] [module α β] : Type v :=
(carrier : set β)
(to_is_submodule : is_submodule carrier)

namespace submodule
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} [ring α] [module α β] [module α γ] [module α δ]
include α

instance : has_coe (submodule α β) (set β) := ⟨submodule.carrier⟩
instance (s : submodule α β) : is_submodule (s : set β) := submodule.to_is_submodule _
instance : has_mem β (submodule α β) := ⟨λ x y, x ∈ (y : set β)⟩

@[simp] theorem mem_coe {b : β} {s : submodule α β} : b ∈ (s : set β) ↔ b ∈ s := iff.rfl

instance : has_subset (submodule α β) := ⟨λ s t, (s : set β) ⊆ t⟩

@[extensionality] theorem ext {s t : submodule α β} (h : (s : set β) = t) : s = t :=
by cases s; cases t; congr'

protected theorem ext_iff {s t : submodule α β}  : (s : set β) = t ↔ s = t :=
iff.intro ext (assume h, h ▸ rfl)

instance : partial_order (submodule α β) :=
partial_order.lift (coe : submodule α β → set β) $ λ a b, ext

def span (s : set β) : submodule α β := ⟨span s, is_submodule_span⟩

theorem span_subset_iff {s : set β} {t : submodule α β} : span s ⊆ t ↔ s ⊆ t :=
⟨subset.trans subset_span, span_minimal t.2⟩

protected def galois_insertion :
  galois_insertion (@span α β _ _) coe :=
{ choice := λ s h, ⟨s, by rw le_antisymm (by exact subset_span) h; exact is_submodule_span⟩,
  gc := λ s t, span_subset_iff,
  le_l_u := λ s, subset_span,
  choice_eq := λ s h, by ext1; exact le_antisymm (by exact subset_span) h }

instance : complete_lattice (submodule α β) := submodule.galois_insertion.lift_complete_lattice

instance : has_zero (submodule α β) := ⟨⊥⟩

@[simp] theorem sInter_set (S : set (submodule α β)) :
  ((Inf S : submodule α β) : set β) = ⋂ s ∈ S, ↑s := rfl

@[simp] theorem bot_set :  ((⊥ : submodule α β) : set β) = {0} := span_empty

@[simp] theorem span_empty : (span ∅ : submodule α β) = ⊥ := rfl

@[simp] theorem top_set : ((⊤ : submodule α β) : set β) = univ := rfl

@[simp] theorem Union_set_of_directed {ι} (hι : nonempty ι)
  (S : ι → submodule α β)
  (H : ∀ i j, ∃ k, S i ≤ S k ∧ S j ≤ S k) :
  ((supr S : submodule α β) : set β) = ⋃ i, S i :=
begin
  suffices su : is_submodule (⋃ i, (S i : set β)),
  { refine le_antisymm (_ : supr S ≤ ⟨_, su⟩) _,
    { exact supr_le (subset_Union (λ i, ↑(S i))) },
    { exact Union_subset (le_supr S) } },
   unfreezeI,
   exact {
    zero_ := by cases hι with i; simp [-mem_coe];
                exact ⟨i, is_submodule.zero⟩,
    add_ := begin
      simp, intros x y i hi j hj,
      rcases H i j with ⟨k, ik, jk⟩,
      exact ⟨k, is_submodule.add (ik hi) (jk hj)⟩
    end,
    smul := by simp [-mem_coe]; exact λ a x i hi,
      ⟨i, is_submodule.smul a hi⟩ }
end

theorem span_union (s t : set β) : (span (s ∪ t) : submodule α β) = span s ⊔ span t :=
(@submodule.galois_insertion α β _ _).gc.l_sup

/-- The pushforward -/
def map (f : β → γ) (h : is_linear_map f) (m : submodule α β) : submodule α γ :=
by letI := m.to_is_submodule; exact ⟨f '' m, is_submodule.image h⟩

lemma coe_map (f : β → γ) {h : is_linear_map f} (m : submodule α β) :
  (map f h m : set γ) = f '' m := rfl

lemma map_id : map (@id β) is_linear_map.id = @id (submodule α β) :=
by ext; simp [-mem_coe, coe_map]

lemma map_comp (f : β → γ) (g : γ → δ) {hf : is_linear_map f} {hg : is_linear_map g} :
  map (g ∘ f) (is_linear_map.comp hg hf) = map g hg ∘ map f hf :=
by ext : 2; simp [-mem_coe, coe_map, (set.image_comp g f _).symm]

lemma injective_map (f : β → γ) (h : is_linear_map f) (hf : injective f) : injective (map f h) :=
assume a b eq, by rwa [← submodule.ext_iff, coe_map, coe_map, image_eq_image hf, submodule.ext_iff] at eq

/-- The pullback -/
def comap (f : β → γ) (h : is_linear_map f) (m : submodule α γ) : submodule α β :=
by letI := m.to_is_submodule; exact ⟨f ⁻¹' m, is_submodule.preimage h⟩

lemma coe_comap (f : β → γ) {h : is_linear_map f} (m : submodule α γ) :
  (comap f h m : set β) = f ⁻¹' m := rfl

lemma comap_id : comap (@id β) is_linear_map.id = @id (submodule α β) :=
by ext; simp [-mem_coe, coe_comap]

lemma comap_comp (f : β → γ) (g : γ → δ) {hf : is_linear_map f} {hg : is_linear_map g} :
  comap (g ∘ f) (is_linear_map.comp hg hf) = comap f hf ∘ comap g hg :=
by ext : 2; simp [-mem_coe, coe_comap, set.preimage_comp.symm]

lemma injective_comap (f : β → γ) (h : is_linear_map f) (hf : surjective f) : injective (comap f h) :=
assume a b eq,
  by rwa [← submodule.ext_iff, coe_comap, coe_comap, preimage_eq_preimage hf, submodule.ext_iff] at eq

lemma comap_map_eq {f : β → γ} (hf : is_linear_map f) (m : submodule α β) (h : ∀x, f x = 0 → x ∈ m) :
  comap f hf (map f hf m) = m :=
begin
  rw [← submodule.ext_iff, coe_comap, coe_map],
  refine subset.antisymm _ (set.subset_preimage_image _ _),
  rintros x ⟨y, hy, eq⟩,
  have : f (y - x) = 0, { simp [eq, hf.sub, sub_self, -sub_eq_add_neg] },
  have : y - x ∈ m, from h _ this,
  suffices : y - (y - x) ∈ m, { simpa },
  exact is_submodule.sub hy this
end

section subtype
variables (α β) (s : set β) [is_submodule s]

def map_subtype : submodule α s → submodule α β :=
map (coe : s → β) (is_submodule.is_linear_map_coe _)

lemma map_subtype_subset (m : submodule α s) : ↑(map_subtype α β s m) ⊆ s :=
by rintros x ⟨y, Hy, rfl⟩; exact y.property

/-- If N ⊆ M then submodules of N are the same as submodules of M contained in N -/
def map_subtype.order_iso :
  ((≤) : submodule α s → submodule α s → Prop) ≃o
  ((≤) : {m : submodule α β // ↑m ⊆ s} → {m : submodule α β // ↑m ⊆ s} → Prop) :=
{ to_fun := λP, ⟨map_subtype α β s P, map_subtype_subset α β s P⟩,
  inv_fun := λ Q, comap (coe : s → β) (is_submodule.is_linear_map_coe _) Q,
  left_inv := by tidy,
  right_inv := by tidy,
  ord := λ X Y, ⟨by tidy, assume h : subtype.val '' ↑X ⊆ subtype.val '' ↑Y, show X ⊆ Y, from
      (image_subset_image_iff subtype.val_injective).1 h⟩ }

def map_subtype.le_order_embedding :
  ((≤) : submodule α s → submodule α s → Prop) ≼o ((≤) : submodule α β → submodule α β → Prop) :=
order_embedding.trans (order_iso.to_order_embedding $ map_subtype.order_iso α β s) (subtype.order_embedding _ _)

@[simp] lemma map_subtype_embedding_eq (P : submodule α s) :
  map_subtype.le_order_embedding α β s P = map_subtype α β s P := rfl

def lt_order_embedding :
  ((<) : submodule α s → submodule α s → Prop) ≼o ((<) : submodule α β → submodule α β → Prop) :=
(map_subtype.le_order_embedding α β s).lt_embedding_of_le_embedding

end subtype

section quotient
open quotient_module is_submodule
variables (α β) (s : set β) [is_submodule s]

def comap_quotient : submodule α (quotient β s) → submodule α β :=
submodule.comap quotient_module.mk (is_linear_map_quotient_mk s)

lemma subset_comap_quotient (m : submodule α (quotient β s)) : s ⊆ comap_quotient α β s m :=
assume n hn, show ↑n ∈ m,
by rw [← quotient_module.coe_eq_zero s] at hn;
from hn.symm ▸ @is_submodule.zero _ _ _ _ (m : set (quotient β s)) _

/-- Correspondence Theorem -/
def comap_quotient.order_iso :
  ((≤) : submodule α (quotient β s) → submodule α (quotient β s) → Prop) ≃o
  ((≤) : {m : submodule α β // s ⊆ m} → {m : submodule α β // s ⊆ m} → Prop) :=
{ to_fun := λm, ⟨comap_quotient α β s m, subset_comap_quotient α β s m⟩,
  inv_fun := λ X, submodule.map quotient_module.mk (is_linear_map_quotient_mk s) X,
  left_inv := λ P, submodule.ext $ set.image_preimage_eq quotient_module.quotient.exists_rep,
  right_inv :=
  begin
    rintros ⟨P, hP⟩,
    have : ∀ (x : β), (x : quotient β s) = (0 : quotient β s) → x ∈ P,
    { assume a, rw [quotient_module.coe_eq_zero s], exact @hP a },
    simp [comap_quotient, comap_map_eq (is_linear_map_quotient_mk s) P this]
  end,
  ord := by tidy }

end quotient

section prod

def prod (s : submodule α β) (t : submodule α γ) : submodule α (β × γ) :=
comap prod.fst prod.is_linear_map_prod_fst s ⊓ comap prod.snd prod.is_linear_map_prod_snd t

lemma coe_prod (s : submodule α β) (t : submodule α γ) : (prod s t : set (β × γ)) = set.prod s t :=
rfl

end prod

end submodule

namespace quotient_module

def le_order_embedding (R) [ring R] (M) [module R M] (N : set M) [is_submodule N] :
  ((≤) : submodule R (quotient M N) → submodule R (quotient M N) → Prop) ≼o
  ((≤): submodule R M → submodule R M → Prop) :=
order_embedding.trans (order_iso.to_order_embedding $
  submodule.comap_quotient.order_iso R M N) (subtype.order_embedding _ _)

def lt_order_embedding (R) [ring R] (M) [module R M] (N : set M) [is_submodule N] :
  ((<) : submodule R (quotient M N) → submodule R (quotient M N) → Prop) ≼o
  ((<) : submodule R M → submodule R M → Prop) :=
(quotient_module.le_order_embedding R M N).lt_embedding_of_le_embedding

end quotient_module


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

/-!
# Quasiconvex and quasiconcave functions

This file defines quasiconvexity, quasiconcavity and quasilinearity of functions, which are
generalizations of unimodality and monotonicity. Convexity implies quasiconvexity, concavity implies
quasiconcavity, and monotonicity implies quasilinearity.

## Main declarations

* `quasiconvex_on 𝕜 s f`: Quasiconvexity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex.
* `quasiconcave_on 𝕜 s f`: Quasiconcavity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex.
* `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This
  means that `f` is both quasiconvex and quasiconcave.

## TODO

Prove that a quasilinear function between two linear orders is either monotone or antitone. This is
not hard but quite a pain to go about as there are many cases to consider.

## References

* https://en.wikipedia.org/wiki/Quasiconvex_function
-/

open set

variables {𝕜 E F β : Type*}

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section ordered_add_comm_monoid
variables (𝕜) [ordered_add_comm_monoid β] [has_scalar 𝕜 E] (s : set E) (f : E → β)

/-- A function is quasiconvex if all its sublevels are convex.
This means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex. -/
def quasiconvex_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | f x ≤ r}

/-- A function is quasiconcave if all its superlevels are convex.
This means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex. -/
def quasiconcave_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | r ≤ f x}

/-- A function is quasilinear if it is both quasiconvex and quasiconcave.
This means that, for all `r`,
the sets `{x ∈ s | f x ≤ r}` and `{x ∈ s | r ≤ f x}` are `𝕜`-convex. -/
def quasilinear_on : Prop :=
quasiconvex_on 𝕜 s f ∧ quasiconcave_on 𝕜 s f

variables {𝕜 s f}

lemma quasiconvex_on.dual (hf : quasiconvex_on 𝕜 s f) :
  @quasiconcave_on 𝕜 E (order_dual β) _ _ _ _ s f :=
hf

lemma quasiconcave_on.dual (hf : quasiconcave_on 𝕜 s f) :
  @quasiconvex_on 𝕜 E (order_dual β) _ _ _ _ s f :=
hf

lemma quasilinear_on.dual (hf : quasilinear_on 𝕜 s f) :
  @quasilinear_on 𝕜 E (order_dual β) _ _ _ _ s f :=
⟨hf.2, hf.1⟩

lemma convex.quasiconvex_on_of_convex_le (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | f x ≤ r}) :
  quasiconvex_on 𝕜 s f :=
λ r, hs.inter (h r)

lemma convex.quasiconcave_on_of_convex_ge (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | r ≤ f x}) :
  quasiconcave_on 𝕜 s f :=
@convex.quasiconvex_on_of_convex_le 𝕜 E (order_dual β) _ _ _ _ _ _ hs h

end ordered_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid β]

section has_scalar
variables [has_scalar 𝕜 E] {s : set E} {f g : E → β}

-- This only requires `directed_order β` but we don't have `directed_ordered_add_comm_monoid`
lemma quasiconvex_on.convex (hf : quasiconvex_on 𝕜 s f) : convex 𝕜 s :=
λ x y hx hy a b ha hb hab,  (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).1

lemma quasiconcave_on.convex (hf : quasiconcave_on 𝕜 s f) : convex 𝕜 s :=
hf.dual.convex

lemma quasiconvex_on.sup (hf : quasiconvex_on 𝕜 s f) (hg : quasiconvex_on 𝕜 s g) :
  quasiconvex_on 𝕜 s (f ⊔ g) :=
begin
  intro r,
  simp_rw [pi.sup_def, sup_le_iff, ←set.sep_inter_sep],
  exact (hf r).inter (hg r),
end

lemma quasiconcave_on.inf (hf : quasiconcave_on 𝕜 s f) (hg : quasiconcave_on 𝕜 s g) :
  quasiconcave_on 𝕜 s (f ⊓ g) :=
hf.dual.sup hg

lemma quasiconvex_on_iff_le_max :
  quasiconvex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ≤ max (f x) (f y) :=
⟨λ hf, ⟨hf.convex, λ x y hx hy a b ha hb hab,
  (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).2⟩,
  λ hf r x y hx hy a b ha hb hab,
  ⟨hf.1 hx.1 hy.1 ha hb hab, (hf.2 hx.1 hy.1 ha hb hab).trans $ max_le hx.2 hy.2⟩⟩

lemma quasiconcave_on_iff_min_le :
  quasiconcave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      min (f x) (f y) ≤ f (a • x + b • y) :=
@quasiconvex_on_iff_le_max 𝕜 E (order_dual β) _ _ _ _ _ _

lemma quasilinear_on_iff_mem_interval :
  quasilinear_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ∈ interval (f x) (f y) :=
begin
  rw [quasilinear_on, quasiconvex_on_iff_le_max, quasiconcave_on_iff_min_le, and_and_and_comm,
    and_self],
  apply and_congr_right',
  simp_rw [←forall_and_distrib, interval, mem_Icc, and_comm],
end

lemma quasiconvex_on.convex_lt (hf : quasiconvex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} :=
begin
  refine λ x y hx hy a b ha hb hab, _,
  have h := hf _ ⟨hx.1, le_max_left _ _⟩ ⟨hy.1, le_max_right _ _⟩ ha hb hab,
  exact ⟨h.1, h.2.trans_lt $ max_lt hx.2 hy.2⟩,
end

lemma quasiconcave_on.convex_gt (hf : quasiconcave_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | r < f x} :=
hf.dual.convex_lt r

end has_scalar

section ordered_smul
variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.quasiconvex_on (hf : convex_on 𝕜 s f) : quasiconvex_on 𝕜 s f :=
hf.convex_le

lemma concave_on.quasiconcave_on (hf : concave_on 𝕜 s f) : quasiconcave_on 𝕜 s f :=
hf.convex_ge

end ordered_smul
end linear_ordered_add_comm_monoid
end add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E]
  [ordered_smul 𝕜 E] {s : set E} {f : E → β}

lemma monotone_on.quasiconvex_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma monotone_on.quasiconcave_on (hf : monotone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma monotone_on.quasilinear_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma antitone_on.quasiconvex_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma antitone_on.quasiconcave_on (hf : antitone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma antitone_on.quasilinear_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma monotone.quasiconvex_on (hf : monotone f) : quasiconvex_on 𝕜 univ f :=
(hf.monotone_on _).quasiconvex_on convex_univ

lemma monotone.quasiconcave_on (hf : monotone f) : quasiconcave_on 𝕜 univ f :=
(hf.monotone_on _).quasiconcave_on convex_univ

lemma monotone.quasilinear_on (hf : monotone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

lemma antitone.quasiconvex_on (hf : antitone f) : quasiconvex_on 𝕜 univ f :=
(hf.antitone_on _).quasiconvex_on convex_univ

lemma antitone.quasiconcave_on (hf : antitone f) : quasiconcave_on 𝕜 univ f :=
(hf.antitone_on _).quasiconcave_on convex_univ

lemma antitone.quasilinear_on (hf : antitone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

end linear_ordered_add_comm_monoid
end ordered_semiring