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

/-!
# Intervals in `with_top α` and `with_bot α`

In this file we prove various lemmas about `set.image`s and `set.preimage`s of intervals under
`coe : α → with_top α` and `coe : α → with_bot α`.
-/

open set

variables {α : Type*}

/-! ### `with_top` -/

namespace with_top

@[simp] lemma preimage_coe_top : (coe : α → with_top α) ⁻¹' {⊤} = (∅ : set α) :=
eq_empty_of_subset_empty $ λ a, coe_ne_top

variables [partial_order α] {a b : α}

lemma range_coe : range (coe : α → with_top α) = Iio ⊤ :=
begin
  ext x,
  rw [mem_Iio, lt_top_iff_ne_top, mem_range, ← none_eq_top, option.ne_none_iff_exists],
  refl,
end

@[simp] lemma preimage_coe_Ioi : (coe : α → with_top α) ⁻¹' (Ioi a) = Ioi a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Ici : (coe : α → with_top α) ⁻¹' (Ici a) = Ici a := ext $ λ x, coe_le_coe
@[simp] lemma preimage_coe_Iio : (coe : α → with_top α) ⁻¹' (Iio a) = Iio a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Iic : (coe : α → with_top α) ⁻¹' (Iic a) = Iic a := ext $ λ x, coe_le_coe

@[simp]

@[simp] lemma preimage_coe_Ico : (coe : α → with_top α) ⁻¹' (Ico a b) = Ico a b :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioc : (coe : α → with_top α) ⁻¹' (Ioc a b) = Ioc a b :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo : (coe : α → with_top α) ⁻¹' (Ioo a b) = Ioo a b :=
by simp [← Ioi_inter_Iio]

@[simp] lemma preimage_coe_Iio_top : (coe : α → with_top α) ⁻¹' (Iio ⊤) = univ :=
by rw [← range_coe, preimage_range]

@[simp] lemma preimage_coe_Ico_top : (coe : α → with_top α) ⁻¹' (Ico a ⊤) = Ici a :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioo_top : (coe : α → with_top α) ⁻¹' (Ioo a ⊤) = Ioi a :=
by simp [← Ioi_inter_Iio]

lemma image_coe_Ioi : (coe : α → with_top α) '' (Ioi a) = Ioo a ⊤ :=
by rw [← preimage_coe_Ioi, image_preimage_eq_inter_range, range_coe, Ioi_inter_Iio]

lemma image_coe_Ici : (coe : α → with_top α) '' (Ici a) = Ico a ⊤ :=
by rw [← preimage_coe_Ici, image_preimage_eq_inter_range, range_coe, Ici_inter_Iio]

lemma image_coe_Iio : (coe : α → with_top α) '' (Iio a) = Iio a :=
by rw [← preimage_coe_Iio, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Iio_subset_Iio le_top)]

lemma image_coe_Iic : (coe : α → with_top α) '' (Iic a) = Iic a :=
by rw [← preimage_coe_Iic, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Iic_subset_Iio.2 $ coe_lt_top a)]

lemma image_coe_Icc : (coe : α → with_top α) '' (Icc a b) = Icc a b :=
by rw [← preimage_coe_Icc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Icc_subset_Iic_self $ Iic_subset_Iio.2 $ coe_lt_top b)]

lemma image_coe_Ico : (coe : α → with_top α) '' (Ico a b) = Ico a b :=
by rw [← preimage_coe_Ico, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ico_subset_Iio_self $ Iio_subset_Iio le_top)]

lemma image_coe_Ioc : (coe : α → with_top α) '' (Ioc a b) = Ioc a b :=
by rw [← preimage_coe_Ioc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioc_subset_Iic_self $ Iic_subset_Iio.2 $ coe_lt_top b)]

lemma image_coe_Ioo : (coe : α → with_top α) '' (Ioo a b) = Ioo a b :=
by rw [← preimage_coe_Ioo, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioo_subset_Iio_self $ Iio_subset_Iio le_top)]

end with_top

/-! ### `with_bot` -/

namespace with_bot

@[simp] lemma preimage_coe_bot : (coe : α → with_bot α) ⁻¹' {⊥} = (∅ : set α) :=
@with_top.preimage_coe_top αᵒᵈ

variables [partial_order α] {a b : α}

lemma range_coe : range (coe : α → with_bot α) = Ioi ⊥ := @with_top.range_coe αᵒᵈ _

@[simp] lemma preimage_coe_Ioi : (coe : α → with_bot α) ⁻¹' (Ioi a) = Ioi a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Ici : (coe : α → with_bot α) ⁻¹' (Ici a) = Ici a := ext $ λ x, coe_le_coe
@[simp] lemma preimage_coe_Iio : (coe : α → with_bot α) ⁻¹' (Iio a) = Iio a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Iic : (coe : α → with_bot α) ⁻¹' (Iic a) = Iic a := ext $ λ x, coe_le_coe

@[simp] lemma preimage_coe_Icc : (coe : α → with_bot α) ⁻¹' (Icc a b) = Icc a b :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_coe_Ico : (coe : α → with_bot α) ⁻¹' (Ico a b) = Ico a b :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioc : (coe : α → with_bot α) ⁻¹' (Ioc a b) = Ioc a b :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo : (coe : α → with_bot α) ⁻¹' (Ioo a b) = Ioo a b :=
by simp [← Ioi_inter_Iio]

@[simp] lemma preimage_coe_Ioi_bot : (coe : α → with_bot α) ⁻¹' (Ioi ⊥) = univ :=
by rw [← range_coe, preimage_range]

@[simp] lemma preimage_coe_Ioc_bot : (coe : α → with_bot α) ⁻¹' (Ioc ⊥ a) = Iic a :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo_bot : (coe : α → with_bot α) ⁻¹' (Ioo ⊥ a) = Iio a :=
by simp [← Ioi_inter_Iio]

lemma image_coe_Iio : (coe : α → with_bot α) '' (Iio a) = Ioo ⊥ a :=
by rw [← preimage_coe_Iio, image_preimage_eq_inter_range, range_coe, inter_comm, Ioi_inter_Iio]

lemma image_coe_Iic : (coe : α → with_bot α) '' (Iic a) = Ioc ⊥ a :=
by rw [← preimage_coe_Iic, image_preimage_eq_inter_range, range_coe, inter_comm, Ioi_inter_Iic]

lemma image_coe_Ioi : (coe : α → with_bot α) '' (Ioi a) = Ioi a :=
by rw [← preimage_coe_Ioi, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Ioi_subset_Ioi bot_le)]

lemma image_coe_Ici : (coe : α → with_bot α) '' (Ici a) = Ici a :=
by rw [← preimage_coe_Ici, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Icc : (coe : α → with_bot α) '' (Icc a b) = Icc a b :=
by rw [← preimage_coe_Icc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Icc_subset_Ici_self $ Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Ioc : (coe : α → with_bot α) '' (Ioc a b) = Ioc a b :=
by rw [← preimage_coe_Ioc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioc_subset_Ioi_self $ Ioi_subset_Ioi bot_le)]

lemma image_coe_Ico : (coe : α → with_bot α) '' (Ico a b) = Ico a b :=
by rw [← preimage_coe_Ico, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ico_subset_Ici_self $ Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Ioo : (coe : α → with_bot α) '' (Ioo a b) = Ioo a b :=
by rw [← preimage_coe_Ioo, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioo_subset_Ioi_self $ Ioi_subset_Ioi bot_le)]

end with_bot


namespace prop_20

variables P Q : Prop

theorem prop_20 : ¬ ¬ (P ∧ Q) → ¬ ¬ Q :=
assume h1: ¬ ¬ (P ∧ Q),
have h2: P ∧ Q, from (classical.by_contradiction
  (assume h2: ¬ (P ∧ Q),
   h1 h2)),
assume h3: ¬ Q,
have h4: Q, from and.right h2,
show false, from h3 h4

-- end namespace
end prop_20


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.unordered_interval
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Order-connected sets

We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.

In this file we prove that intersection of a family of `ord_connected` sets is `ord_connected` and
that all standard intervals are `ord_connected`.
-/

namespace set

/--
We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.
-/
def ord_connected {α : Type u_1} [preorder α] (s : set α) :=
  ∀ {x : α}, x ∈ s → ∀ {y : α}, y ∈ s → Icc x y ⊆ s

/-- It suffices to prove `[x, y] ⊆ s` for `x y ∈ s`, `x ≤ y`. -/
theorem ord_connected_iff {α : Type u_1} [preorder α] {s : set α} : ord_connected s ↔ ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → x ≤ y → Icc x y ⊆ s := sorry

theorem ord_connected_of_Ioo {α : Type u_1} [partial_order α] {s : set α} (hs : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → x < y → Ioo x y ⊆ s) : ord_connected s := sorry

protected theorem Icc_subset {α : Type u_1} [preorder α] (s : set α) [hs : ord_connected s] {x : α} {y : α} (hx : x ∈ s) (hy : y ∈ s) : Icc x y ⊆ s :=
  hs hx hy

theorem ord_connected.inter {α : Type u_1} [preorder α] {s : set α} {t : set α} (hs : ord_connected s) (ht : ord_connected t) : ord_connected (s ∩ t) :=
  fun (x : α) (hx : x ∈ s ∩ t) (y : α) (hy : y ∈ s ∩ t) =>
    subset_inter (hs (and.left hx) (and.left hy)) (ht (and.right hx) (and.right hy))

protected instance ord_connected.inter' {α : Type u_1} [preorder α] {s : set α} {t : set α} [ord_connected s] [ord_connected t] : ord_connected (s ∩ t) :=
  ord_connected.inter _inst_2 _inst_3

theorem ord_connected.dual {α : Type u_1} [preorder α] {s : set α} (hs : ord_connected s) : ord_connected s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) (z : order_dual α) (hz : z ∈ Icc x y) =>
    hs hy hx { left := and.right hz, right := and.left hz }

theorem ord_connected_dual {α : Type u_1} [preorder α] {s : set α} : ord_connected s ↔ ord_connected s :=
  { mp := fun (h : ord_connected s) => ord_connected.dual h, mpr := fun (h : ord_connected s) => ord_connected.dual h }

theorem ord_connected_sInter {α : Type u_1} [preorder α] {S : set (set α)} (hS : ∀ (s : set α), s ∈ S → ord_connected s) : ord_connected (⋂₀S) :=
  fun (x : α) (hx : x ∈ ⋂₀S) (y : α) (hy : y ∈ ⋂₀S) =>
    subset_sInter fun (s : set α) (hs : s ∈ S) => hS s hs (hx s hs) (hy s hs)

theorem ord_connected_Inter {α : Type u_1} [preorder α] {ι : Sort u_2} {s : ι → set α} (hs : ∀ (i : ι), ord_connected (s i)) : ord_connected (Inter fun (i : ι) => s i) :=
  ord_connected_sInter (iff.mpr forall_range_iff hs)

protected instance ord_connected_Inter' {α : Type u_1} [preorder α] {ι : Sort u_2} {s : ι → set α} [∀ (i : ι), ord_connected (s i)] : ord_connected (Inter fun (i : ι) => s i) :=
  ord_connected_Inter _inst_2

theorem ord_connected_bInter {α : Type u_1} [preorder α] {ι : Sort u_2} {p : ι → Prop} {s : (i : ι) → p i → set α} (hs : ∀ (i : ι) (hi : p i), ord_connected (s i hi)) : ord_connected (Inter fun (i : ι) => Inter fun (hi : p i) => s i hi) :=
  ord_connected_Inter fun (i : ι) => ord_connected_Inter (hs i)

theorem ord_connected_pi {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)] {s : set ι} {t : (i : ι) → set (α i)} (h : ∀ (i : ι), i ∈ s → ord_connected (t i)) : ord_connected (pi s t) :=
  fun (x : (i : ι) → α i) (hx : x ∈ pi s t) (y : (i : ι) → α i) (hy : y ∈ pi s t) (z : (i : ι) → α i) (hz : z ∈ Icc x y)
    (i : ι) (hi : i ∈ s) => h i hi (hx i hi) (hy i hi) { left := and.left hz i, right := and.right hz i }

protected instance ord_connected_pi' {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)] {s : set ι} {t : (i : ι) → set (α i)} [h : ∀ (i : ι), ord_connected (t i)] : ord_connected (pi s t) :=
  ord_connected_pi fun (i : ι) (hi : i ∈ s) => h i

instance ord_connected_Ici {α : Type u_1} [preorder α] {a : α} : ord_connected (Ici a) :=
  fun (x : α) (hx : x ∈ Ici a) (y : α) (hy : y ∈ Ici a) (z : α) (hz : z ∈ Icc x y) => le_trans hx (and.left hz)

instance ord_connected_Iic {α : Type u_1} [preorder α] {a : α} : ord_connected (Iic a) :=
  fun (x : α) (hx : x ∈ Iic a) (y : α) (hy : y ∈ Iic a) (z : α) (hz : z ∈ Icc x y) => le_trans (and.right hz) hy

instance ord_connected_Ioi {α : Type u_1} [preorder α] {a : α} : ord_connected (Ioi a) :=
  fun (x : α) (hx : x ∈ Ioi a) (y : α) (hy : y ∈ Ioi a) (z : α) (hz : z ∈ Icc x y) => lt_of_lt_of_le hx (and.left hz)

instance ord_connected_Iio {α : Type u_1} [preorder α] {a : α} : ord_connected (Iio a) :=
  fun (x : α) (hx : x ∈ Iio a) (y : α) (hy : y ∈ Iio a) (z : α) (hz : z ∈ Icc x y) => lt_of_le_of_lt (and.right hz) hy

instance ord_connected_Icc {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Icc a b) :=
  ord_connected.inter ord_connected_Ici ord_connected_Iic

instance ord_connected_Ico {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ico a b) :=
  ord_connected.inter ord_connected_Ici ord_connected_Iio

instance ord_connected_Ioc {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ioc a b) :=
  ord_connected.inter ord_connected_Ioi ord_connected_Iic

instance ord_connected_Ioo {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ioo a b) :=
  ord_connected.inter ord_connected_Ioi ord_connected_Iio

instance ord_connected_singleton {α : Type u_1} [partial_order α] {a : α} : ord_connected (singleton a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ord_connected (singleton a))) (Eq.symm (Icc_self a)))) ord_connected_Icc

instance ord_connected_empty {α : Type u_1} [preorder α] : ord_connected ∅ :=
  fun (x : α) => false.elim

instance ord_connected_univ {α : Type u_1} [preorder α] : ord_connected univ :=
  fun (_x : α) (_x_1 : _x ∈ univ) (_x_2 : α) (_x_3 : _x_2 ∈ univ) => subset_univ (Icc _x _x_2)

/-- In a dense order `α`, the subtype from an `ord_connected` set is also densely ordered. -/
protected instance densely_ordered {α : Type u_1} [preorder α] [densely_ordered α] {s : set α} [hs : ord_connected s] : densely_ordered ↥s :=
  densely_ordered.mk
    fun (a₁ a₂ : ↥s) (ha : a₁ < a₂) =>
      Exists.dcases_on (exists_between ha)
        fun (x : α) (h : ↑a₁ < x ∧ x < ↑a₂) =>
          and.dcases_on h
            fun (ha₁x : ↑a₁ < x) (hxa₂ : x < ↑a₂) =>
              Exists.intro
                { val := x,
                  property :=
                    hs (subtype.property a₁) (subtype.property a₂) (Ioo_subset_Icc_self { left := ha₁x, right := hxa₂ }) }
                { left := ha₁x, right := hxa₂ }

instance ord_connected_interval {β : Type u_2} [linear_order β] {a : β} {b : β} : ord_connected (interval a b) :=
  ord_connected_Icc

theorem ord_connected.interval_subset {β : Type u_2} [linear_order β] {s : set β} (hs : ord_connected s) {x : β} (hx : x ∈ s) {y : β} (hy : y ∈ s) : interval x y ⊆ s := sorry

theorem ord_connected_iff_interval_subset {β : Type u_2} [linear_order β] {s : set β} : ord_connected s ↔ ∀ {x : β}, x ∈ s → ∀ {y : β}, y ∈ s → interval x y ⊆ s := sorry


/-
Copyright (c) 2020 Ruben Van de Velde. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde
-/

import algebra.algebra.restrict_scalars
import data.complex.is_R_or_C

/-!
# Extending a continuous `ℝ`-linear map to a continuous `𝕜`-linear map

In this file we provide a way to extend a continuous `ℝ`-linear map to a continuous `𝕜`-linear map
in a way that bounds the norm by the norm of the original map, when `𝕜` is either `ℝ` (the
extension is trivial) or `ℂ`. We formulate the extension uniformly, by assuming `is_R_or_C 𝕜`.

We motivate the form of the extension as follows. Note that `fc : F →ₗ[𝕜] 𝕜` is determined fully by
`Re fc`: for all `x : F`, `fc (I • x) = I * fc x`, so `Im (fc x) = -Re (fc (I • x))`. Therefore,
given an `fr : F →ₗ[ℝ] ℝ`, we define `fc x = fr x - fr (I • x) * I`.

## Main definitions

* `linear_map.extend_to_𝕜`
* `continuous_linear_map.extend_to_𝕜`

## Implementation details

For convenience, the main definitions above operate in terms of `restrict_scalars ℝ 𝕜 F`.
Alternate forms which operate on `[is_scalar_tower ℝ 𝕜 F]` instead are provided with a primed name.

-/

open is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [normed_space 𝕜 F]
local notation `abs𝕜` := @is_R_or_C.abs 𝕜 _

/-- Extend `fr : F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜` in a way that will also be continuous and have its norm
bounded by `∥fr∥` if `fr` is continuous. -/
noncomputable def linear_map.extend_to_𝕜'
  [module ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 :=
begin
  let fc : F → 𝕜 := λ x, (fr x : 𝕜) - (I : 𝕜) * (fr ((I : 𝕜) • x)),
  have add : ∀ x y : F, fc (x + y) = fc x + fc y,
  { assume x y,
    simp only [fc],
    simp only [smul_add, linear_map.map_add, of_real_add],
    rw mul_add,
    abel, },
  have A : ∀ (c : ℝ) (x : F), (fr ((c : 𝕜) • x) : 𝕜) = (c : 𝕜) * (fr x : 𝕜),
  { assume c x,
    rw [← of_real_mul],
    congr' 1,
    rw [is_R_or_C.of_real_alg, smul_assoc, fr.map_smul, algebra.id.smul_eq_mul, one_smul] },
  have smul_ℝ : ∀ (c : ℝ) (x : F), fc ((c : 𝕜) • x) = (c : 𝕜) * fc x,
  { assume c x,
    simp only [fc, A],
    rw A c x,
    rw [smul_smul, mul_comm I (c : 𝕜), ← smul_smul, A, mul_sub],
    ring },
  have smul_I : ∀ x : F, fc ((I : 𝕜) • x) = (I : 𝕜) * fc x,
  { assume x,
    simp only [fc],
    cases @I_mul_I_ax 𝕜 _ with h h, { simp [h] },
    rw [mul_sub, ← mul_assoc, smul_smul, h],
    simp only [neg_mul_eq_neg_mul_symm, linear_map.map_neg, one_mul, one_smul,
      mul_neg_eq_neg_mul_symm, of_real_neg, neg_smul, sub_neg_eq_add, add_comm] },
  have smul_𝕜 : ∀ (c : 𝕜) (x : F), fc (c • x) = c • fc x,
  { assume c x,
    rw [← re_add_im c, add_smul, add_smul, add, smul_ℝ, ← smul_smul, smul_ℝ, smul_I, ← mul_assoc],
    refl },
  exact { to_fun := fc, map_add' := add, map_smul' := smul_𝕜 }
end

lemma linear_map.extend_to_𝕜'_apply [module ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →ₗ[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- The norm of the extension is bounded by `∥fr∥`. -/
lemma norm_bound [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →L[ℝ] ℝ) (x : F) :
  ∥(fr.to_linear_map.extend_to_𝕜' x : 𝕜)∥ ≤ ∥fr∥ * ∥x∥ :=
begin
  let lm : F →ₗ[𝕜] 𝕜 := fr.to_linear_map.extend_to_𝕜',
  -- We aim to find a `t : 𝕜` such that
  -- * `lm (t • x) = fr (t • x)` (so `lm (t • x) = t * lm x ∈ ℝ`)
  -- * `∥lm x∥ = ∥lm (t • x)∥` (so `t.abs` must be 1)
  -- If `lm x ≠ 0`, `(lm x)⁻¹` satisfies the first requirement, and after normalizing, it
  -- satisfies the second.
  -- (If `lm x = 0`, the goal is trivial.)
  classical,
  by_cases h : lm x = 0,
  { rw [h, norm_zero],
    apply mul_nonneg; exact norm_nonneg _ },
  let fx := (lm x)⁻¹,
  let t := fx / (abs𝕜 fx : 𝕜),
  have ht : abs𝕜 t = 1, by field_simp [abs_of_real, of_real_inv, is_R_or_C.abs_inv,
    is_R_or_C.abs_div, is_R_or_C.abs_abs, h],
  have h1 : (fr (t • x) : 𝕜) = lm (t • x),
  { apply ext,
    { simp only [lm, of_real_re, linear_map.extend_to_𝕜'_apply, mul_re, I_re, of_real_im, zero_mul,
        add_monoid_hom.map_sub, sub_zero, mul_zero],
      refl },
    { symmetry,
      calc im (lm (t • x))
          = im (t * lm x) : by rw [lm.map_smul, smul_eq_mul]
      ... = im ((lm x)⁻¹ / (abs𝕜 (lm x)⁻¹) * lm x) : rfl
      ... = im (1 / (abs𝕜 (lm x)⁻¹ : 𝕜)) : by rw [div_mul_eq_mul_div, inv_mul_cancel h]
      ... = 0 : by rw [← of_real_one, ← of_real_div, of_real_im]
      ... = im (fr (t • x) : 𝕜) : by rw [of_real_im] } },
  calc ∥lm x∥ = abs𝕜 t * ∥lm x∥ : by rw [ht, one_mul]
  ... = ∥t * lm x∥ : by rw [← norm_eq_abs, normed_field.norm_mul]
  ... = ∥lm (t • x)∥ : by rw [←smul_eq_mul, lm.map_smul]
  ... = ∥(fr (t • x) : 𝕜)∥ : by rw h1
  ... = ∥fr (t • x)∥ : by rw [norm_eq_abs, abs_of_real, norm_eq_abs, abs_to_real]
  ... ≤ ∥fr∥ * ∥t • x∥ : continuous_linear_map.le_op_norm _ _
  ... = ∥fr∥ * (∥t∥ * ∥x∥) : by rw norm_smul
  ... ≤ ∥fr∥ * ∥x∥ : by rw [norm_eq_abs, ht, one_mul]
end

/-- Extend `fr : F →L[ℝ] ℝ` to `F →L[𝕜] 𝕜`. -/
noncomputable def continuous_linear_map.extend_to_𝕜' [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →L[ℝ] ℝ) :
  F →L[𝕜] 𝕜 :=
linear_map.mk_continuous _ (∥fr∥) (norm_bound _)

lemma continuous_linear_map.extend_to_𝕜'_apply [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F]
  (fr : F →L[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- Extend `fr : restrict_scalars ℝ 𝕜 F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜`. -/
noncomputable def linear_map.extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 :=
fr.extend_to_𝕜'

lemma linear_map.extend_to_𝕜_apply (fr : (restrict_scalars ℝ 𝕜 F) →ₗ[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜 x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl

/-- Extend `fr : restrict_scalars ℝ 𝕜 F →L[ℝ] ℝ` to `F →L[𝕜] 𝕜`. -/
noncomputable def continuous_linear_map.extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) :
  F →L[𝕜] 𝕜 :=
fr.extend_to_𝕜'

lemma continuous_linear_map.extend_to_𝕜_apply (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) (x : F) :
  fr.extend_to_𝕜 x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import combinatorics.quiver.subquiver
import combinatorics.quiver.path

/-!
## Weakly connected components

For a quiver `V`, we build a quiver `symmetrify V` by adding a reversal of every edge.
Informally, a path in `symmetrify V` corresponds to a 'zigzag' in `V`. This lets us
define the type `weakly_connected_component V` as the quotient of `V` by the relation which
identifies `a` with `b` if there is a path from `a` to `b` in `symmetrify V`. (These
zigzags can be seen as a proof-relevant analogue of `eqv_gen`.)

Strongly connected components have not yet been defined.
-/
universes v u

namespace quiver

/-- A type synonym for the symmetrized quiver (with an arrow both ways for each original arrow).
    NB: this does not work for `Prop`-valued quivers. It requires `[quiver.{v+1} V]`. -/
@[nolint has_inhabited_instance]
def symmetrify (V) : Type u := V

instance symmetrify_quiver (V : Type u) [quiver V] : quiver (symmetrify V) :=
⟨λ a b : V, (a ⟶ b) ⊕ (b ⟶ a)⟩

variables (V : Type u) [quiver.{v+1} V]

/-- A quiver `has_reverse` if we can reverse an arrow `p` from `a` to `b` to get an arrow
    `p.reverse` from `b` to `a`.-/
class has_reverse :=
(reverse' : Π {a b : V}, (a ⟶ b) → (b ⟶ a))

instance : has_reverse (symmetrify V) := ⟨λ a b e, e.swap⟩

variables {V}

/-- Reverse the direction of an arrow. -/
def reverse [has_reverse V] {a b : V} : (a ⟶ b) → (b ⟶ a) := has_reverse.reverse'

/-- Reverse the direction of a path. -/
def path.reverse [has_reverse V] {a : V} : Π {b}, path a b → path b a
| a path.nil := path.nil
| b (path.cons p e) := (reverse e).to_path.comp p.reverse

variables (V)

/-- Two vertices are related in the zigzag setoid if there is a
    zigzag of arrows from one to the other. -/
def zigzag_setoid : setoid V :=
⟨λ a b, nonempty (@path (symmetrify V) _ a b),
 λ a, ⟨path.nil⟩,
 λ a b ⟨p⟩, ⟨p.reverse⟩,
 λ a b c ⟨p⟩ ⟨q⟩, ⟨p.comp q⟩⟩

/-- The type of weakly connected components of a directed graph. Two vertices are
    in the same weakly connected component if there is a zigzag of arrows from one
    to the other. -/
def weakly_connected_component : Type* := quotient (zigzag_setoid V)

namespace weakly_connected_component
variable {V}

/-- The weakly connected component corresponding to a vertex. -/
protected def mk : V → weakly_connected_component V := quotient.mk'

instance : has_coe_t V (weakly_connected_component V) := ⟨weakly_connected_component.mk⟩
instance [inhabited V] : inhabited (weakly_connected_component V) := ⟨show V, from default⟩

protected lemma eq (a b : V) :
  (a : weakly_connected_component V) = b ↔ nonempty (@path (symmetrify V) _ a b) :=
quotient.eq'

end weakly_connected_component

variable {V}

/-- A wide subquiver `H` of `G.symmetrify` determines a wide subquiver of `G`, containing an
    an arrow `e` if either `e` or its reversal is in `H`. -/
-- Without the explicit universe level in `quiver.{v+1}` Lean comes up with
-- `quiver.{max u_2 u_3 + 1}`. This causes problems elsewhere, so we write `quiver.{v+1}`.
def wide_subquiver_symmetrify (H : wide_subquiver (symmetrify V)) : wide_subquiver V :=
λ a b, { e | sum.inl e ∈ H a b ∨ sum.inr e ∈ H b a }

end quiver


/-
 (c) 2022 Henrik Böving. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/

namespace Cpdt
namespace Chapter3

inductive NatTree where
  | node : Nat → List NatTree → NatTree

#check NatTree.rec -- not useful for use with the induction tactic since it has two motives

def all (p : α → Prop) : List α → Prop
  | [] => True
  | x :: xs => p x ∧ all p xs

@[simp] theorem all_nil : all p [] := True.intro
@[simp] theorem all_cons : all p (x :: xs) = (p x ∧ all p xs) := by rfl

namespace NatTree

section Ind

variable {motive : NatTree → Prop}
variable (node_case : ∀ (n : Nat) (ls : List NatTree), all motive ls → motive (node n ls))

mutual
  def nat_tree_ind : (tr : NatTree) → motive tr
    | node n rest => node_case n rest (list_nat_tree_ind rest)

  def list_nat_tree_ind : (ls : List NatTree) → all motive ls
    | [] => True.intro
    | l :: ls => And.intro (nat_tree_ind l) (list_nat_tree_ind ls)
end

end Ind

#check nat_tree_ind

-- Sadly writing the definition like in the book doesnt work yet :(
mutual
  def size : NatTree → Nat
    | node x ts => 1 + nodeListSize ts

  def nodeListSize : List NatTree → Nat
    | [] => 0
    | t :: ts => size t + nodeListSize ts
end

def splice : NatTree → NatTree → NatTree
  | node x [], t2 => node x [t2]
  | node x (t :: ts), t2 => node x (splice t t2 :: ts)

@[simp] theorem size_tree : size (node x ts) = 1 + nodeListSize ts := by rw [size]
@[simp] theorem nodeListSize_nil : nodeListSize [] = 0 := by rfl
@[simp] theorem nodeListSize_cons : nodeListSize (t :: ts) = size t + nodeListSize ts := by rw[nodeListSize]
@[simp] theorem splice_node_nil : splice (node x []) t2 = node x [t2] := by rfl
@[simp] theorem splice_node_cons : splice (node x (t :: ts)) t2 = node x (splice t t2 :: ts) := by rw[splice]

theorem splice_size : ∀ t1 t2, size (splice t1 t2) = size t1 + size t2 := by
  intro t1
  induction t1 using nat_tree_ind with
  | node_case x ts ih =>
    cases ts <;> simp_all
    simp_arith

end NatTree

end Chapter3
end Cpdt


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.cast.field

/-!
# Injectivity of `int.cast` into characteristic zero rings and fields.

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

-/

variables {α : Type*}

open nat

namespace int

@[simp]
theorem cast_eq_zero [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) = 0 ↔ n = 0 :=
⟨λ h, begin cases n,
  { rw [int.cast_of_nat] at h, exact congr_arg coe (nat.cast_eq_zero.1 h) },
  { rw [cast_neg_succ_of_nat, neg_eq_zero, nat.cast_eq_zero] at h,
    contradiction }
end, λ h, by rw [h, cast_zero]⟩

@[simp, norm_cast] theorem cast_inj [add_group_with_one α] [char_zero α] {m n : ℤ} :
  (m : α) = n ↔ m = n :=
by rw [← sub_eq_zero, ← cast_sub, cast_eq_zero, sub_eq_zero]

theorem cast_injective [add_group_with_one α] [char_zero α] : function.injective (coe : ℤ → α)
| m n := cast_inj.1

theorem cast_ne_zero [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

@[simp] lemma cast_eq_one [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) = 1 ↔ n = 1 :=
by rw [←cast_one, cast_inj]

lemma cast_ne_one [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 1 ↔ n ≠ 1 :=
cast_eq_one.not

@[simp, norm_cast]
theorem cast_div_char_zero {k : Type*} [division_ring k] [char_zero k] {m n : ℤ}
  (n_dvd : n ∣ m) : ((m / n : ℤ) : k) = m / n :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp [int.div_zero] },
  { exact cast_div n_dvd (cast_ne_zero.mpr hn), },
end

end int

lemma ring_hom.injective_int {α : Type*} [non_assoc_ring α] (f : ℤ →+* α) [char_zero α] :
  function.injective f :=
subsingleton.elim (int.cast_ring_hom _) f ▸ int.cast_injective


/-
Copyright (c) 2020 Ruben Van de Velde, Stanislas Polu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde, Stanislas Polu
-/

import data.real.basic
import analysis.normed_space.basic

/-!
# IMO 1972 B2

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.
-/

/--
This proof begins by introducing the supremum of `f`, `k ≤ 1` as well as `k' = k / ∥g y∥`. We then
suppose that the conclusion does not hold (`hneg`) and show that `k ≤ k'` (by
`2 * (∥f x∥ * ∥g y∥) ≤ 2 * k` obtained from the main hypothesis `hf1`) and that `k' < k` (obtained
from `hneg` directly), finally raising a contradiction with `k' < k'`.

(Authored by Stanislas Polu inspired by Ruben Van de Velde).
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f(x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : ∀ y, ∥f(y)∥ ≤ 1)
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ∥g(y)∥ ≤ 1 :=
begin
  classical,
  set S := set.range (λ x, ∥f x∥),
  -- Introduce `k`, the supremum of `f`.
  let k : ℝ := Sup (S),

  -- Show that `∥f x∥ ≤ k`.
  have hk₁ : ∀ x, ∥f x∥ ≤ k,
  { have h : bdd_above S, from ⟨1, set.forall_range_iff.mpr hf2⟩,
    intro x,
    exact le_cSup h (set.mem_range_self x), },
  -- Show that `2 * (∥f x∥ * ∥g y∥) ≤ 2 * k`.
  have hk₂ : ∀ x, 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k,
  { intro x,
    calc 2 * (∥f x∥ * ∥g y∥)
        = ∥2 * f x * g y∥ : by simp [real.norm_eq_abs, abs_mul, mul_assoc]
    ... = ∥f (x + y) + f (x - y)∥ : by rw hf1
    ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : norm_add_le _ _
    ... ≤ k + k : add_le_add (hk₁ _) (hk₁ _)
    ... = 2 * k : (two_mul _).symm, },

  -- Suppose the conclusion does not hold.
  by_contra' hneg,
  set k' := k / ∥g y∥,

  -- Demonstrate that `k' < k` using `hneg`.
  have H₁ : k' < k,
  { have h₁ : 0 < k,
    { obtain ⟨x, hx⟩ := hf3,
      calc 0
          < ∥f x∥ : norm_pos_iff.mpr hx
      ... ≤ k : hk₁ x },
    rw div_lt_iff,
    apply lt_mul_of_one_lt_right h₁ hneg,
    exact trans zero_lt_one hneg },

  -- Demonstrate that `k ≤ k'` using `hk₂`.
  have H₂ : k ≤ k',
  { have h₁ : ∃ x : ℝ, x ∈ S,
    { use ∥f 0∥, exact set.mem_range_self 0, },
    have h₂ : ∀ x, ∥f x∥ ≤ k',
    { intros x,
      rw le_div_iff,
      { apply (mul_le_mul_left zero_lt_two).mp (hk₂ x) },
      { exact trans zero_lt_one hneg } },
    apply cSup_le h₁,
    rintros y' ⟨yy, rfl⟩,
    exact h₂ yy },

  -- Conclude by obtaining a contradiction, `k' < k'`.
  apply lt_irrefl k',
  calc k'
      < k : H₁
  ... ≤ k' : H₂,
end

/-- IMO 1972 B2

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.

This is a more concise version of the proof proposed by Ruben Van de Velde.
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f (x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : bdd_above (set.range (λ x, ∥f x∥)))
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ∥g(y)∥ ≤ 1 :=
begin
  obtain ⟨x, hx⟩ := hf3,
  set k := ⨆ x, ∥f x∥,
  have h : ∀ x, ∥f x∥ ≤ k := le_csupr hf2,
  by_contra' H,
  have hgy : 0 < ∥g y∥,
    by linarith,
  have k_pos : 0 < k := lt_of_lt_of_le (norm_pos_iff.mpr hx) (h x),
  have : k / ∥g y∥ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H),
  have : k ≤ k / ∥g y∥,
  { suffices : ∀ x, ∥f x∥ ≤ k / ∥g y∥, from csupr_le this,
    intro x,
    suffices : 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k,
      by { rwa [le_div_iff hgy, ←mul_le_mul_left zero_lt_two], apply_instance },
    calc 2 * (∥f x∥ * ∥g y∥)
        = ∥2 * f x * g y∥           : by simp [abs_mul, mul_assoc]
    ... = ∥f (x + y) + f (x - y)∥   : by rw hf1
    ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : abs_add _ _
    ... ≤ 2 * k                     : by linarith [h (x+y), h (x -y)] },
  linarith,
end


/- Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------
# Morphisms of Categories: Functors
😺 🐈 😼 🐈⬛ 😸 🐈 🙀 😻 🐈 😹
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import lectures.lec16_categories_basic

/-! ## Philosophical Remarks
We mentioned that categories encompass many many mathematical structures. What is amazing is that categories, encompass categories too! Categories are themselves mathematical structures, and there is a good notion of "morphism between categories" which relates them. Such morphisms are called functors and they are very important in studying relating one field of mathematics to the other. For instance, in algebraic topology, we study spaces by their fundamental groups (or groupoids). ...
-/

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

infixr ` ⟶ `:10 := precategory_str.hom -- type as \h
notation `𝟙` := precategory_str.id -- type as \b1
-- infixr ` ⊚ `:80 := precategory_str.comp-- type as \oo
local notation f ` ⊚ `:80 g:80 := precategory_str.comp g f    -- type as \oo

open PROOFS
open PROOFS.STR

namespace category_str

/-! ## Functors

Functors are homomorphism of categories, they are the way we map one category into another.

A homomorphism `F : 𝓒 → 𝓓` maps

- the objects of `𝓒` to the objects of `𝓓` (via a function `F₀ : 𝓒.obj → 𝓓.obj`)
- the morphisms of `𝓒` to the morphisms of `𝓓` (via a function `F₁ : 𝓒.mor → 𝓓.mor`)

in such a way that the operations of identity and compositions are preserved, i.e.

- `F₁ (𝟙 X) = 𝟙 (F₀ X)` --  identities in `𝓒` go to identities in `𝓓`
- `F₁ (g ⊚ f) = F₁(g) ⊚ F₁(f)` -- compositions in `𝓒` go to compositions in `𝓓`
-/

--set_option old_structure_cmd true

structure functor (𝓒 : Type u₁) [category_str.{v₁} 𝓒] (𝓓 : Type u₂) [category_str.{v₂} 𝓓] : Type (max v₁ v₂ u₁ u₂) :=
(obj [] : 𝓒 → 𝓓) -- the object function of functor structure
(mor [] : Π {X Y : 𝓒}, (X ⟶ Y) → (obj X ⟶ obj Y)) -- the morphism function of functor structure
(resp_id'   :
∀ (X : 𝓒), mor (𝟙 X) = 𝟙 (obj X) )
(resp_comp' :
∀ {X Y Z : 𝓒} (f : X ⟶ Y) (g : Y ⟶ Z), mor (g ⊚ f) = (mor g) ⊚  (mor f) )

-- attribute [class] functor

#print functor

#check functor.obj -- the first function part of a  functor structure which maps objetcs to objects
#check functor.mor --  the second function part of a  functor structure which maps morphisms to morphisms

section test
variables {𝓒 𝓓 : Type} [category_str.{v₁} 𝓒] [category_str.{v₂} 𝓓]
variable F : functor 𝓒 𝓓
#check F.obj  -- our informal notation for this was `F₀`
#check F.mor  -- our informal notation for this was `F₁`
variables {X Y Z : 𝓒}
variable g : X ⟶ Y
variable f : Y ⟶ Z
#check f ⊚ g
#check F.mor g -- F₁ g : F₀ X → F₀ Y
#check F.mor (f ⊚ g )
end test

infixr ` ⥤ `:26 := functor       -- type as \func --

restate_axiom functor.resp_id'
attribute [simp] functor.resp_id
restate_axiom functor.resp_comp'
attribute [simp] functor.resp_comp

namespace functor

#check @resp_id

variables {𝓒 : Type u₁} [category_str.{v₁} 𝓒]
          {𝓓  : Type u₂} [category_str.{v₂} 𝓓]
          {𝓔 : Type u₃} [category_str.{v₃} 𝓔]
          {𝓕 : Type u₄} [category_str.{v₄} 𝓕]
-- font MC stands for mathcal 𝓑

-- a test that `attribute [simp] functor.resp_id'` works
example (F : 𝓒 ⥤ 𝓓) (X : 𝓒) : F.mor (𝟙 X) = 𝟙 (F.obj X) :=
begin
  simp,
end

-- a test that `attribute [simp] functor.resp_comp'` works
example (F : 𝓒 ⥤ 𝓓) {X Y Z : 𝓒} (f : X ⟶ Y) (g : Y ⟶ Z) :
  F.mor (g ⊚ f ) = (F.mor g) ⊚ (F.mor f) :=
begin
  simp only [functor.resp_comp],
end

/- `𝟭 𝓒` is the identity functor on a category `𝓒`. -/
def id (𝓒 : Type u₁) [category_str.{v₁} 𝓒] : 𝓒 ⥤ 𝓒 :=
{
  obj := id,
  mor := λ X, λ Y, λ f, f,
  resp_id' := by {intro X, refl, },
  resp_comp' := by {intros X Y Z, intro f, intro g, refl,}
}

notation `𝟭` := functor.id -- Type this as `\sb1`

/- The identity function acts trivially on objects, i.e. it keeps them the same.-/
@[simp]
lemma id_obj (X : 𝓒) :
  (𝟭 𝓒).obj X = X :=
begin
  refl,
end

/- The identity function acts trivially on morphisms, i.e. it keeps them the same.-/
@[simp]
lemma id_mor {X Y : 𝓒} (f : X ⟶ Y) :
  (𝟭 𝓒).mor f = f :=
begin
  refl,
end

-- see how `simp` did it by uncommenting the line below:
--set_option trace.simplify.rewrite true

/- We can __compose__ functors. -/
def comp (F : functor 𝓒 𝓓) (G : functor 𝓓 𝓔) : functor 𝓒 𝓔 :=
{
  obj :=  λ X, G.obj (F.obj X), -- G.obj ∘ F.obj,
  mor := λ X, λ Y, λ f, G.mor (F.mor f),
  resp_id' := by {intro X, simp only [functor.resp_id ], },
  resp_comp' := by {intros X Y Z f g, simp only [functor.resp_comp],},
}

-- /- We can __compose__ functors. -/
-- def comp (F : 𝓒 ⥤ 𝓓) (G : 𝓓 ⥤ 𝓔) : 𝓒 ⥤ 𝓔 :=
-- {
--   obj :=  λ X, let t := (F.obj X) in G.obj t, -- G.obj ∘ F.obj,
--   mor := λ X, λ Y, λ f, G.mor (F.mor f),
--   resp_id' := by {intro X, simp },
--   resp_comp' := by {intros X Y Z f g, simp only [functor.resp_comp],},
-- }

#check @functor.comp

local notation F ` ⊚⊚ `:80 G:80 := functor.comp G F

@[simp]
lemma comp_id_obj (F : 𝓒 ⥤ 𝓓) (X : 𝓒) :
  (F ⊚⊚ 𝟭 𝓒).obj X  = (F.obj X) :=
begin
  refl,
end

@[simp]
lemma comp_id_mor (F : 𝓒 ⥤ 𝓓) {X Y : 𝓒} (f : X ⟶ Y) :
  (F ⊚⊚ 𝟭 𝓒).mor f  = (F.mor f) :=
begin
  refl,
end

@[simp]
lemma id_comp_obj (F : 𝓒 ⥤ 𝓓) (X : 𝓒) :
  (𝟭 𝓓 ⊚⊚ F).obj X  = (F.obj X) :=
begin
  refl,
end

@[simp]
lemma id_comp_mor (F : 𝓒 ⥤ 𝓓) {X Y : 𝓒} (f : X ⟶ Y) :
  (𝟭 𝓓 ⊚⊚ F).mor f  = (F.mor f) :=
begin
  refl,
end

lemma id_comp (F : 𝓒 ⥤ 𝓓) :
  (𝟭 𝓓 ⊚⊚ F)  = F :=
begin
  sorry,
end

lemma comp_id (F : 𝓒 ⥤ 𝓓) :
  (F ⊚⊚ 𝟭 𝓒)  = F :=
begin
  sorry,
end

@[simp]
lemma comp_assoc_obj (F : 𝓒 ⥤ 𝓓) (G : 𝓓 ⥤ 𝓔) (H : 𝓔 ⥤ 𝓕)
(X : 𝓒) :
  ((H ⊚⊚ G) ⊚⊚ F).obj X = (H ⊚⊚ (G ⊚⊚ F)).obj X :=
begin
  refl,
end

@[simp]
lemma comp_assoc_mor (F : 𝓒 ⥤ 𝓓) (G : 𝓓 ⥤ 𝓔) (H : 𝓔 ⥤ 𝓕) (X Y: 𝓒) (f : X ⟶ Y):
  ((H ⊚⊚ G) ⊚⊚ F).mor f = (H ⊚⊚ (G ⊚⊚ F)).mor f :=
begin
  refl,
end

/-! ## Representable Functors
To every object `X` of a category `𝓒` we can associate a functor `Ϳ X : 𝓒 ⥤ Type*` which maps an object `Y` in `𝓒` to the type `X ⟶ Y` of morphisms from `X` to `Y` in `𝓒`.

Recall that To build a functor `F : 𝓒 ⥤ 𝓓` we need to specify four fields
* `obj : 𝓒 → 𝓓`
* `mor : ∀ {X Y : 𝓒} (f : X ⟶ Y), obj X ⟶ obj Y`
* `map_id'` and `map_comp'`, expressing the functor laws.
-/

--set_option trace.simp_lemmas true
@[simp]
def representable {𝓒 : Type*}[category_str 𝓒] (X : 𝓒) : 𝓒 ⥤ Type* :=
{
  obj := λ Y, X ⟶ Y,
  mor := λ Y Z f g, f ⊚ g,
  resp_id' := by {intro Y, funext, simp, refl, },
  resp_comp' := by {intros X Y Z f g, funext, simp, refl},
}

local notation ` Ϳ ` : 15 :=  functor.representable

-- if `𝓒` is the cateogry of types, we have
#check Ϳ ℕ
#reduce (Ϳ ℕ).obj
#reduce (Ϳ ℕ).obj ℤ

#check 𝓒
#check 𝓒ᵒᵖ
#check @category_str.opposite_cat 𝓒ᵒᵖ

@[simp]
def corepresentable {𝓒 : Type*}[category_str 𝓒] (X : 𝓒) : 𝓒ᵒᵖ ⥤ (Type*) :=
{
  obj := λ Y, unop Y ⟶ X, -- want 𝓒-morphisms from `Y` to `X`
  mor := λ Y Z f g, g ⊚ (hom.unop f),
  resp_id' := by {intro Y, funext, simp only [unop_id], simp, refl,  },
  resp_comp' := by {intros U' V' W' f g, simp only [unop_comp], funext x, rw ← comp_assoc, refl, },
}

end functor

/- An example of bundling a type class with the base type is given by bundling the type class of `mult_monoid_str` which results in the type of monoids (i.e. types equipped with an instance of `mult_monoid_str`)-/

#check monoid

#check mult_monoid_str

structure mult_Monoid' :=
(carrier : Type)
(str : mult_monoid_str carrier )

#check mult_Monoid' -- this is the type of all monoids, i.e. a carrier type equipped with a s multiplicative monoid structure.

/-
Similarly we can form the bundled type of all groups, rings, categories, etc. However, we like to have a uniform way of doing this, not only to save us the laborious work, but also introduced a general type class (`bundled` in below) which can be used for further instance synthesis and general coercions.
-/

structure bundled (C : Type* → Type*) :=
(carrier : Type*)
(str : C carrier ) -- `C` is a type class specifying a structure.

#check bundled

/-- A generic function for lifting a type equipped with an instance of a type class to an instance of a bundled type. -/

def bundled_of (C : Type* → Type*) (X : Type*) [str : C X] : bundled C := ⟨X, str⟩

#check bundled_of

#check nat.mult_monoid_str -- an instance of multiplicative monoid strucutre we defined in a previous lecture

#check bundled_of mult_monoid_str ℕ -- Using ℕ and the instance `nat.mult_monoid_str` to define an instance of type `bundled mult_monoid_str`.

variable {C : Type u₁ → Type v₁}
-- forgetting the structure `C` and returning the carrier type.
instance : has_coe_to_sort (bundled C) (Type*) := ⟨bundled.carrier⟩ -- an example would be to treat a group as its underlying type when needed.

#check @bundled.mk -- Given a type class `C` and a `carrier X`, and an instance of `CX` the ouput is an instance of `bundled C`
#check @bundled.mk mult_monoid_str ℕ

@[simp]
lemma coe_mk {C : Type u₁ → Type v₁} (carrier : Type u₁) (str) :
  (@bundled.mk C carrier str : Type u₁) = carrier :=
begin
  refl,
end

def mult_Monoid : Type* := bundled mult_monoid_str
def additive_Monoid := bundled additive_monoid_str
def additive_comm_Monoid := bundled comm_additive_monoid_str
def mult_Group : Type (u₁+1):= bundled mult_group_str
def additive_Group := bundled additive_group_str

/- Type of categories -/
def Cat := bundled small_category_str -- The type of small categories (where the types of morphims live in the universe `v`)

#check Cat

/- Examples of use of bundled types:

If we have a term `M : mult_Monoid` ie a type bundled together with a monoid structure, then we can immediately infer that `M.str` is a monoid structure on the underlying type `M.carrier`.
-/
instance (M : mult_Monoid) : mult_monoid_str M.carrier := M.str
instance (G :additive_Group) : additive_group_str G.carrier := G.str

#check bundled.str

/-! ## The Category of Monoids
Recall from HW10 how the idenity homomorphism of monoids and the compositions of homomorphisms of monoids were defined.

Here we also prove the unitality and associativity of composition.
-/

def mult_monoid.morphism.id {M : Type}[mult_monoid_str M] : M →ₘ* M :=
{

  to_fun := id,
  resp_one := by {simp},
  resp_mul := by {simp},
}

@[simp]
def mult_monoid.morphism.comp {L M N : Type} [mult_monoid_str L] [mult_monoid_str M] [mult_monoid_str N] (g : M →ₘ* N) (f : L →ₘ* M) : L →ₘ* N :=
{ to_fun := g ∘ f,
  resp_one := by {simp},
  resp_mul := by {simp,}, }

--infixr  ` ∘* ` : 90  := mult_monoid.morphism.comp

local notation F ` ⊚⊚ `:80 G:80 := functor.comp G F

@[simp]
lemma mult_monoid.morphism.id_comp {L M : Type} [mult_monoid_str L] [mult_monoid_str M]  (f : L →ₘ* M)  :
  mult_monoid.morphism.id  ∘* f = f :=
begin
  ext,
  refl,
end

@[simp]
lemma mult_monoid.morphism.comp_id {L M : Type} [mult_monoid_str L] [mult_monoid_str M]  (f : L →ₘ* M)  :
  f ∘* mult_monoid.morphism.id = f :=
begin
  ext,
  refl,
end

@[simp]
def mult_monoid.morphism.comp_assoc {K L M N: Type} [mult_monoid_str K] [mult_monoid_str L] [mult_monoid_str M] [mult_monoid_str N] (f : K →ₘ* L) (g : L →ₘ* M) (h : M →ₘ* N) :
  (h ∘* g) ∘* f = h ∘* (g ∘* f) :=
begin
  refl,
end

instance cat_of_monoids : category_str (mult_Monoid) :=
{
  hom := λ X Y, X.carrier →ₘ* Y.carrier,
  id := λ X, mult_monoid.morphism.id,
  comp := λ X Y Z, λ f g, g ∘* f,
  id_comp' := by {intros X Y f, simp,},
  comp_id' := by {intros X Y f, simp,},
  comp_assoc' := by {intros X Y Z W f g h, apply  mult_monoid.morphism.comp_assoc},
}

#check category_str (mult_Monoid)

#check category_str.cat_of_monoids
#check category_str.cat_of_monoids.comp

/-
Challenge: do the same for groups.
-/

#check mult_Monoid
#check functor

universe u
structure internal_monoid (𝓒 : Type u) [category_str 𝓒] : Type u :=
(mon : 𝓒)
(mon_mul : mon × mon ⟶ mon )

--set_option pp.instantiate_mvars false

--set_option trace.class_instances true
def forgetful_functor : category_str.functor mult_Monoid  mult_Monoid :=
sorry

/-! ## The Category of categories and functors
(Small) categories and functors between them form a (large) category. To show this, we first need to have a (larger) type of all categories and then introduce morphisms (i.e. functors) as part of the would-be structure of large category of categories. We do this by introducing a uniform way for bundling a type equipped with a type class. Examples below make this more clear.
-/

#check Cat -- Type of small categories

/- We want to endow `Cat` with the structure of category. -/

instance str (𝓒 : Cat) : small_category_str.{v₁} 𝓒.carrier := 𝓒.str

--instance : has_coe_to_sort Cat (Type u) := ⟨bundled.carrier⟩

--set_option trace.simplify.rewrite true
/-- Category structure on `Cat` -/
instance cat_of_cat : large_category_str Cat  :=
{
  hom := λ 𝓒 𝓓, 𝓒.carrier ⥤ 𝓓.carrier,
  id := λ 𝓒, 𝟭 𝓒.carrier,
  /- For composition after introducing `𝓒 𝓓 𝓔 F G` the context and goal are as follows

  𝓒 𝓓 𝓔 : Cat,
  F : ↥𝓒 ⥤ ↥𝓓,
  G : ↥𝓓 ⥤ ↥𝓔
  ⊢ ↥𝓒 ⥤ ↥𝓔

  Here `↥𝓒` is the underlying type of the category `𝓒`.
  -/
  comp := λ 𝓒 𝓓 𝓔 F G, G ⊚⊚ F,
  id_comp' := by {intros 𝓒 𝓓 F, apply functor.id_comp},
  comp_id' := by {intros 𝓒 𝓓 F, apply functor.id_comp, }
 }

#check Cat ⥤ Cat

#check Cat
#check category_str Cat
#check category_str.cat_of_cat

def delooping_cat (M : mult_Monoid) : Cat :=
⟨ (punit : Type u₁), category_str.delooping M.carrier⟩

#check delooping_cat -- a function which sends a monoid to its deloopint category

@[simp]
lemma deloop_type (M : mult_Monoid)  :
  (delooping_cat M).carrier = (punit : Type u₁) :=
begin
  refl,
end

-- lemma deloop_mor (M : mult_Monoid) (X Y : (delooping_cat M).carrier) (m : X ⟶ Y) : (m : M.carrier) :=

#check delooping_cat

#check category_str.delooping

/- Delooping is a functor `mult_Monoid ⥤ Cat` -/

#check functor

def delooping_functor : mult_Monoid ⥤ Cat :=
{
  obj := λ X, ⟨ punit, category_str.delooping X.carrier ⟩,
  mor := sorry,
  resp_id' := sorry,
  resp_comp' := sorry,
}

end category_str


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov

! This file was ported from Lean 3 source module data.finsupp.antidiagonal
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Multiset
import Mathbin.Data.Multiset.Antidiagonal

/-!
# The `finsupp` counterpart of `multiset.antidiagonal`.

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

The antidiagonal of `s : α →₀ ℕ` consists of
all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
-/

noncomputable section

open Classical BigOperators

namespace Finsupp

open Finset

variable {α : Type _}

#print Finsupp.antidiagonal' /-
/-- The `finsupp` counterpart of `multiset.antidiagonal`: the antidiagonal of
`s : α →₀ ℕ` consists of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
The finitely supported function `antidiagonal s` is equal to the multiplicities of these pairs. -/
def antidiagonal' (f : α →₀ ℕ) : (α →₀ ℕ) × (α →₀ ℕ) →₀ ℕ :=
  (f.toMultiset.antidiagonal.map (Prod.map Multiset.toFinsupp Multiset.toFinsupp)).toFinsupp
#align finsupp.antidiagonal' Finsupp.antidiagonal'
-/

#print Finsupp.antidiagonal /-
/-- The antidiagonal of `s : α →₀ ℕ` is the finset of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)`
such that `t₁ + t₂ = s`. -/
def antidiagonal (f : α →₀ ℕ) : Finset ((α →₀ ℕ) × (α →₀ ℕ)) :=
  f.antidiagonal'.support
#align finsupp.antidiagonal Finsupp.antidiagonal
-/

#print Finsupp.mem_antidiagonal /-
@[simp]
theorem mem_antidiagonal {f : α →₀ ℕ} {p : (α →₀ ℕ) × (α →₀ ℕ)} :
    p ∈ antidiagonal f ↔ p.1 + p.2 = f :=
  by
  rcases p with ⟨p₁, p₂⟩
  simp [antidiagonal, antidiagonal', ← and_assoc, ← finsupp.to_multiset.apply_eq_iff_eq]
#align finsupp.mem_antidiagonal Finsupp.mem_antidiagonal
-/

#print Finsupp.swap_mem_antidiagonal /-
theorem swap_mem_antidiagonal {n : α →₀ ℕ} {f : (α →₀ ℕ) × (α →₀ ℕ)} :
    f.symm ∈ antidiagonal n ↔ f ∈ antidiagonal n := by
  simp only [mem_antidiagonal, add_comm, Prod.swap]
#align finsupp.swap_mem_antidiagonal Finsupp.swap_mem_antidiagonal
-/

/- warning: finsupp.antidiagonal_filter_fst_eq -> Finsupp.antidiagonal_filter_fst_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (f : Finsupp.{u1, 0} α Nat Nat.hasZero) (g : Finsupp.{u1, 0} α Nat Nat.hasZero) [D : forall (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)), Decidable (Eq.{succ u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) g)], Eq.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.filter.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => Eq.{succ u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) g) (fun (a : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => D a) (Finsupp.antidiagonal.{u1} α f)) (ite.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (LE.le.{u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.hasLe.{u1, 0} α Nat Nat.hasZero Nat.hasLe) g f) (Finsupp.decidableLE.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) (fun (a : Nat) (b : Nat) => Nat.decidableLe a b) g f) (Singleton.singleton.{u1, u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.hasSingleton.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Prod.mk.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) g (HSub.hSub.{u1, u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) (instHSub.{u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.tsub.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) Nat.hasSub Nat.hasOrderedSub)) f g))) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.hasEmptyc.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)))))
but is expected to have type
  forall {α : Type.{u1}} (f : Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (g : Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) [D : forall (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))), Decidable (Eq.{succ u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) g)], Eq.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.filter.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => Eq.{succ u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) g) (fun (a : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => D a) (Finsupp.antidiagonal.{u1} α f)) (ite.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (LE.le.{u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.instLEFinsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero) instLENat) g f) (Finsupp.decidableLE.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) (fun (a : Nat) (b : Nat) => Nat.decLe a b) g f) (Singleton.singleton.{u1, u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.instSingletonFinset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Prod.mk.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) g (HSub.hSub.{u1, u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (instHSub.{u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.tsub.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) instSubNat Nat.instOrderedSubNatInstLENatInstAddNatInstSubNat)) f g))) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.instEmptyCollectionFinset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))))))
Case conversion may be inaccurate. Consider using '#align finsupp.antidiagonal_filter_fst_eq Finsupp.antidiagonal_filter_fst_eqₓ'. -/
theorem antidiagonal_filter_fst_eq (f g : α →₀ ℕ)
    [D : ∀ p : (α →₀ ℕ) × (α →₀ ℕ), Decidable (p.1 = g)] :
    ((antidiagonal f).filterₓ fun p => p.1 = g) = if g ≤ f then {(g, f - g)} else ∅ :=
  by
  ext ⟨a, b⟩
  suffices a = g → (a + b = f ↔ g ≤ f ∧ b = f - g) by
    simpa [apply_ite ((· ∈ ·) (a, b)), ← and_assoc, @and_right_comm _ (a = _), and_congr_left_iff]
  rintro rfl
  constructor
  · rintro rfl
    exact ⟨le_add_right le_rfl, (add_tsub_cancel_left _ _).symm⟩
  · rintro ⟨h, rfl⟩
    exact add_tsub_cancel_of_le h
#align finsupp.antidiagonal_filter_fst_eq Finsupp.antidiagonal_filter_fst_eq

/- warning: finsupp.antidiagonal_filter_snd_eq -> Finsupp.antidiagonal_filter_snd_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (f : Finsupp.{u1, 0} α Nat Nat.hasZero) (g : Finsupp.{u1, 0} α Nat Nat.hasZero) [D : forall (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)), Decidable (Eq.{succ u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) g)], Eq.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.filter.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => Eq.{succ u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) g) (fun (a : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => D a) (Finsupp.antidiagonal.{u1} α f)) (ite.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (LE.le.{u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.hasLe.{u1, 0} α Nat Nat.hasZero Nat.hasLe) g f) (Finsupp.decidableLE.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) (fun (a : Nat) (b : Nat) => Nat.decidableLe a b) g f) (Singleton.singleton.{u1, u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.hasSingleton.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Prod.mk.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) (HSub.hSub.{u1, u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) (instHSub.{u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.tsub.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) Nat.hasSub Nat.hasOrderedSub)) f g) g)) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero))) (Finset.hasEmptyc.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)))))
but is expected to have type
  forall {α : Type.{u1}} (f : Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (g : Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) [D : forall (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))), Decidable (Eq.{succ u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) g)], Eq.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.filter.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => Eq.{succ u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) g) (fun (a : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => D a) (Finsupp.antidiagonal.{u1} α f)) (ite.{succ u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (LE.le.{u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.instLEFinsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero) instLENat) g f) (Finsupp.decidableLE.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) (fun (a : Nat) (b : Nat) => Nat.decLe a b) g f) (Singleton.singleton.{u1, u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.instSingletonFinset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Prod.mk.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (HSub.hSub.{u1, u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (instHSub.{u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.tsub.{u1, 0} α Nat (CanonicallyOrderedCommSemiring.toCanonicallyOrderedAddMonoid.{0} Nat Nat.canonicallyOrderedCommSemiring) instSubNat Nat.instOrderedSubNatInstLENatInstAddNatInstSubNat)) f g) g)) (EmptyCollection.emptyCollection.{u1} (Finset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)))) (Finset.instEmptyCollectionFinset.{u1} (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u1, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))))))
Case conversion may be inaccurate. Consider using '#align finsupp.antidiagonal_filter_snd_eq Finsupp.antidiagonal_filter_snd_eqₓ'. -/
theorem antidiagonal_filter_snd_eq (f g : α →₀ ℕ)
    [D : ∀ p : (α →₀ ℕ) × (α →₀ ℕ), Decidable (p.2 = g)] :
    ((antidiagonal f).filterₓ fun p => p.2 = g) = if g ≤ f then {(f - g, g)} else ∅ :=
  by
  ext ⟨a, b⟩
  suffices b = g → (a + b = f ↔ g ≤ f ∧ a = f - g) by
    simpa [apply_ite ((· ∈ ·) (a, b)), ← and_assoc, and_congr_left_iff]
  rintro rfl
  constructor
  · rintro rfl
    exact ⟨le_add_left le_rfl, (add_tsub_cancel_right _ _).symm⟩
  · rintro ⟨h, rfl⟩
    exact tsub_add_cancel_of_le h
#align finsupp.antidiagonal_filter_snd_eq Finsupp.antidiagonal_filter_snd_eq

#print Finsupp.antidiagonal_zero /-
@[simp]
theorem antidiagonal_zero : antidiagonal (0 : α →₀ ℕ) = singleton (0, 0) := by
  rw [antidiagonal, antidiagonal', Multiset.toFinsupp_support] <;> rfl
#align finsupp.antidiagonal_zero Finsupp.antidiagonal_zero
-/

/- warning: finsupp.prod_antidiagonal_swap -> Finsupp.prod_antidiagonal_swap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {M : Type.{u2}} [_inst_1 : CommMonoid.{u2} M] (n : Finsupp.{u1, 0} α Nat Nat.hasZero) (f : (Finsupp.{u1, 0} α Nat Nat.hasZero) -> (Finsupp.{u1, 0} α Nat Nat.hasZero) -> M), Eq.{succ u2} M (Finset.prod.{u2, u1} M (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) _inst_1 (Finsupp.antidiagonal.{u1} α n) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => f (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p))) (Finset.prod.{u2, u1} M (Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) _inst_1 (Finsupp.antidiagonal.{u1} α n) (fun (p : Prod.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero)) => f (Prod.snd.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p) (Prod.fst.{u1, u1} (Finsupp.{u1, 0} α Nat Nat.hasZero) (Finsupp.{u1, 0} α Nat Nat.hasZero) p)))
but is expected to have type
  forall {α : Type.{u2}} {M : Type.{u1}} [_inst_1 : CommMonoid.{u1} M] (n : Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (f : (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) -> (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) -> M), Eq.{succ u1} M (Finset.prod.{u1, u2} M (Prod.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) _inst_1 (Finsupp.antidiagonal.{u2} α n) (fun (p : Prod.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => f (Prod.fst.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) (Prod.snd.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p))) (Finset.prod.{u1, u2} M (Prod.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) _inst_1 (Finsupp.antidiagonal.{u2} α n) (fun (p : Prod.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero))) => f (Prod.snd.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p) (Prod.fst.{u2, u2} (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) (Finsupp.{u2, 0} α Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero)) p)))
Case conversion may be inaccurate. Consider using '#align finsupp.prod_antidiagonal_swap Finsupp.prod_antidiagonal_swapₓ'. -/
@[to_additive]
theorem prod_antidiagonal_swap {M : Type _} [CommMonoid M] (n : α →₀ ℕ)
    (f : (α →₀ ℕ) → (α →₀ ℕ) → M) :
    (∏ p in antidiagonal n, f p.1 p.2) = ∏ p in antidiagonal n, f p.2 p.1 :=
  Finset.prod_bij (fun p hp => p.symm) (fun p => swap_mem_antidiagonal.2) (fun p hp => rfl)
    (fun p₁ p₂ _ _ h => Prod.swap_injective h) fun p hp =>
    ⟨p.symm, swap_mem_antidiagonal.2 hp, p.swap_swap.symm⟩
#align finsupp.prod_antidiagonal_swap Finsupp.prod_antidiagonal_swap
#align finsupp.sum_antidiagonal_swap Finsupp.sum_antidiagonal_swap

end Finsupp


import ..library.src_real_field_lemmas
import ..library.src_ordered_field_lemmas
import data.set.basic
import tactic

namespace mth1001

namespace myreal

section upper_bound_of_subset

open myreal_field classical myordered_field

open_locale classical

variables {R : Type} [myreal_field R]

theorem upper_bound_of_subset {S T : set R} {u : R} (h₁ : S ⊆ T) (h₂ : upper_bound u T)
: upper_bound u S :=
begin
  assume (s : R) (h : s ∈ S),
  have h₃ : s ∈ T, from h₁ h,
  exact h₂ s h₃,
end

example (S T : set R) : S ⊆ S ∪ T := set.subset_union_left S T
example (S T : set R) : T ⊆ S ∪ T := set.subset_union_right S T

example (S T : set R) (m₁ m₂ : R) (h₁ : has_upper_bound S) (h₂ : has_upper_bound T)
(h₃ : S ≠ ∅) (h₄ : T ≠ ∅) : is_sup (max (sup S) (sup T)) (S ∪ T) :=
begin
  let M := max (sup S) (sup T),
  cases (sup_is_sup h₁ h₃) with sups_ub sups_lub,
  cases (sup_is_sup h₂ h₄) with supt_ub supt_lub,
  split,
  { sorry, },
  { sorry, },
end

end upper_bound_of_subset

section infima

open myreal_field classical myordered_field

open_locale classical

variables {R : Type} [myreal_field R]

example (S : set R) : minus_set S = {x | -x ∈ S} := rfl

theorem lower_bound_iff_minus_upper_bound {S : set R} {v : R}
: lower_bound v S ↔ upper_bound (-v) (minus_set S) :=
begin
  split,
  { intros lubs s hsm,
    rw [←neg_neg s, neg_le_neg_iff],
    exact lubs (-s) hsm, },
  { intros ubms s hs,
    rw ←neg_le_neg_iff,
    rw ←neg_neg s at hs,
    exact ubms (-s) hs, },
end

theorem is_sup_minus_of_is_inf {S : set R} {v : R} : is_inf v S → is_sup (-v) (minus_set S) :=
begin
  rintro ⟨lb_S, hub⟩,
  have h₁ : upper_bound (-v) (minus_set S),
  { intros s hsm,
    rw [←neg_le_neg_iff, neg_neg],
    exact lb_S (-s) hsm, },
  have h₂ : ∀ x, upper_bound x (minus_set S) → (-v) ≤ x,
  { intros x hubms,
    rw [←neg_neg x, ←lower_bound_iff_minus_upper_bound] at hubms,
    rw [←neg_neg x, neg_le_neg_iff],
    exact hub (-x) hubms, },
  exact and.intro h₁ h₂,
end

theorem is_inf_of_is_sup_minus {S : set R} {v : R} : is_sup (-v) (minus_set S) → is_inf v S :=
begin
  rintro ⟨lb_mS, hub⟩,
  have h₁ : lower_bound v S,
  { intros s hs,
    rw ←neg_le_neg_iff,
    rw ←neg_neg s at hs,
    exact lb_mS (-s) hs, },
  have h₂ : ∀ x, lower_bound x S → x ≤ v,
  { intros x hlbs,
    rw lower_bound_iff_minus_upper_bound at hlbs,
    rw ←neg_le_neg_iff,
    exact hub (-x) hlbs, },
  exact and.intro h₁ h₂,
end

theorem is_inf_iff_is_sup_minus {S : set R} {v : R} : is_inf v S ↔ is_sup (-v) (minus_set S) :=
⟨is_sup_minus_of_is_inf, is_inf_of_is_sup_minus⟩

lemma is_sup_sup_minus_of_has_lb_nonempty {S : set R} (h₁ : has_lower_bound S) (h₂ : S ≠ ∅)
: is_sup (sup (minus_set S)) (minus_set S) :=
begin
  cases h₁ with v hv,
  have k₁ : upper_bound (-v) (minus_set S), from lower_bound_iff_minus_upper_bound.mp hv,
  have k₂ : has_upper_bound (minus_set S), from ⟨-v, k₁⟩,
  have k₃ : (minus_set S) ≠ ∅,
  { rw set.ne_empty_iff_nonempty at *,
    cases h₂ with s hs,
    use (-s),
    rw ←neg_neg s at hs,
    exact hs, },
  exact sup_is_sup k₂ k₃,
end

lemma inf_is_inf {S : set R} (h₁ : has_lower_bound S) (h₂ : S ≠ ∅) : is_inf (inf S) S :=
begin
  have h₂ : is_sup (sup (minus_set S)) (minus_set S) := is_sup_sup_minus_of_has_lb_nonempty h₁ h₂,
  rw [←neg_neg (sup (minus_set S)), ←is_inf_iff_is_sup_minus] at h₂,
  have h₃ : ∃ x, is_inf x S, from ⟨-sup(minus_set S), h₂⟩,
  have h₄ : inf S = some h₃, from dif_pos h₃,
  rw h₄,
  exact some_spec h₃,
end

lemma inf_eq_minus_sup {S : set R} (h₁ : has_lower_bound S) (h₂ : S ≠ ∅)
: inf S = -(sup (minus_set S)) :=
begin
  have h₃ : is_inf (inf S) S, from inf_is_inf h₁ h₂,
  have h₄ : is_sup (-(inf S)) (minus_set S), rwa is_inf_iff_is_sup_minus at h₃,
  have h₅ : is_sup (sup (minus_set S)) (minus_set S) := is_sup_sup_minus_of_has_lb_nonempty h₁ h₂,
  have h₆ : -(inf S) = sup (minus_set S), from sup_uniqueness (minus_set S) _ _ h₄ h₅,
  rw [←h₆, neg_neg],
end

end infima

end myreal

end mth1001


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Mario Carneiro
-/

import Lean

namespace Mathlib.Tactic

open Lean Parser.Tactic

/--
`simp_rw` functions as a mix of `simp` and `rw`. Like `rw`, it applies each
rewrite rule in the given order, but like `simp` it repeatedly applies these
rules and also under binders like `∀ x, ...`, `∃ x, ...` and `λ x, ...`.
Usage:

- `simp_rw [lemma_1, ..., lemma_n]` will rewrite the goal by applying the
  lemmas in that order. A lemma preceded by `←` is applied in the reverse direction.
- `simp_rw [lemma_1, ..., lemma_n] at h₁ ... hₙ` will rewrite the given hypotheses.
- `simp_rw [...] at *` rewrites in the whole context: all hypotheses and the goal.

Lemmas passed to `simp_rw` must be expressions that are valid arguments to `simp`.
For example, neither `simp` nor `rw` can solve the following, but `simp_rw` can:

```lean
example {a : ℕ}
  (h1 : ∀ a b : ℕ, a - 1 ≤ b ↔ a ≤ b + 1)
  (h2 : ∀ a b : ℕ, a ≤ b ↔ ∀ c, c < a → c < b) :
  (∀ b, a - 1 ≤ b) = ∀ b c : ℕ, c < a → c < b + 1 :=
by simp_rw [h1, h2]
```
-/
macro "simp_rw " rws:rwRuleSeq loc:location ? : tactic => do
  let stx ← rws.1[1].getSepArgs.mapM fun
    | `(rwRule| $e:term) => `(tactic| simp%$e only [$e:term] $(loc)?)
    -- FIXME There is a slight regression here after nightly-2022-10-29,
    -- see https://github.com/leanprover/lean4/issues/1791.
    -- Instead of lining up with the `←`, for now we line up with the lemma name.
    -- Perhaps this is good enough anyway.
    | `(rwRule| ← $e:term) => `(tactic| simp%$e only [← $e:term] $(loc)?)
    | _ => Macro.throwUnsupported
  `(tactic| ($[$stx]*))


import tuto_lib
/-
This file continues the elementary study of limits of sequences.
It can be skipped if the previous file was too easy, it won't introduce
any new tactic or trick.

Remember useful lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub_comm (x y : ℝ) : |x - y| = |y - x|

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

and the definition:

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

You can also use a property proved in the previous file:

unique_limit : seq_limit u l → seq_limit u l' → l = l'

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m
-/

variable { φ : ℕ → ℕ}

/-
The next lemma is proved by an easy induction, but we haven't seen induction
in this tutorial. If you did the natural number game then you can delete
the proof below and try to reconstruct it.
-/
/-- An extraction is greater than id -/
lemma id_le_extraction' : extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

/-- Extractions take arbitrarily large values for arbitrarily large
inputs. -/
-- 0039
lemma extraction_ge : extraction φ → ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros hyp N N',
  unfold extraction at hyp,
  use max N N',
  split,
  { exact le_max_right N N', },
  calc N ≤ max N N' : le_max_left N N'
  ... ≤ φ (max N N') : by apply id_le_extraction hyp,
end

/-- A real number `a` is a cluster point of a sequence `u`
if `u` has a subsequence converging to `a`.

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a
-/

variables {u : ℕ → ℝ} {a l : ℝ}

/-
In the exercise, we use `∃ n ≥ N, ...` which is the abbreviation of
`∃ n, n ≥ N ∧ ...`.
Lean can read this abbreviation, but displays it as the confusing:
`∃ (n : ℕ) (H : n ≥ N)`
One gets used to it. Alternatively, one can get rid of it using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q
-/

/-- If `a` is a cluster point of `u` then there are values of
`u` arbitrarily close to `a` for arbitrarily large input. -/
-- 0040
lemma near_cluster :
  cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros ha ε ε_pos N,
  cases ha with φ hφ,
  have rhφ : seq_limit (u ∘ φ) a,
  { exact hφ.right, },
  specialize rhφ ε ε_pos,
  cases rhφ with N' hN',
  specialize hN' (max N N'),
  use (φ (max N N')),
  split,
  have ext : φ(max N N') ≥ max N N',
  { exact id_le_extraction' hφ.left (max N N'),},
  have key : max N N' ≥ N,
  { exact le_max_left N N',},
  linarith,
  apply hN',
  exact le_max_right N N',
end
-- :(
/-
The above exercice can be done in five lines.
Hint: you can use the anonymous constructor syntax when proving
existential statements.
-/

/-- If `u` tends to `l` then its subsequences tend to `l`. -/
-- 0041
lemma subseq_tendsto_of_tendsto' (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  specialize h ε ε_pos,
  cases h with N hN,
  use N,
  intros n hn,
  specialize hN (φ n),
  apply hN,
  have key : φ n ≥ n,
  { exact id_le_extraction' hφ n,},
  linarith,
end

/-- If `u` tends to `l` all its cluster points are equal to `l`. -/
-- 0042
lemma cluster_limit (hl : seq_limit u l) (ha : cluster_point u a) : a = l :=
begin
  cases ha with φ hφ,
  have key : seq_limit (u ∘ φ ) l,
  { exact subseq_tendsto_of_tendsto' hl hφ.left,},
  exact unique_limit hφ.right key,
end

/-- Cauchy_sequence sequence -/
def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

-- 0043
example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  intros h ε ε_pos,
  unfold seq_limit at h,
  cases h with l hl,
  specialize hl (ε/2) (by linarith),
  cases hl with N hN,
  use N,
  intros p q hp hq,
  have key : |l - u q| = |u q - l|,
  {exact abs_sub_comm l (u q),},
  have key2 : |u p - l| ≤ ε/2,
  {exact hN p hp,},
  have key3 : |u q - l| ≤ ε/2,
  {exact hN q hq,},
  calc |u p - u q| = |(u p - l) + (l - u q)| : by ring_nf
  ... ≤ |u p - l| + |l - u q| : abs_add (u p - l) (l - u q)
  ... ≤ ε/2 + ε/2 : by linarith
  ... ≤ ε : by ring_nf,
end

/-
In the next exercise, you can reuse
 near_cluster : cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-/
-- 0044
example (hu : cauchy_sequence u) (hl : cluster_point u l) : seq_limit u l :=
begin
  unfold seq_limit,
  intros ε ε_pos,
  unfold cauchy_sequence at hu,
  have key : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - l| ≤ ε,
  {exact near_cluster hl,},
  specialize hu (ε/2) (by linarith),
  specialize key (ε/2) (by linarith),
  cases hu with N hN,
  specialize key N,
  cases key with n hn,
  cases hn with hnN,
  use N,
  intros i hi,
  specialize hN i n,
  have key2 : |u i - u n| ≤ ε/2,
  { exact hN hi hnN,},
  calc |u i - l| = |(u i - u n) + (u n - l)| : by ring_nf
  ... ≤ |u i - u n| + |u n - l| : abs_add (u i - u n) (u n - l)
  ... ≤ ε/2 + ε/2 : by linarith
  ... ≤ ε : by ring_nf,
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import data.finsupp.basic
import algebra.big_operators.pi
import algebra.big_operators.ring
import algebra.big_operators.order

/-!
# Big operators for finsupps

This file contains theorems relevant to big operators in finitely supported functions.
-/

open_locale big_operators

variables {α ι γ A B C : Type*} [add_comm_monoid A] [add_comm_monoid B] [add_comm_monoid C]
variables {t : ι → A → C} (h0 : ∀ i, t i 0 = 0) (h1 : ∀ i x y, t i (x + y) = t i x + t i y)
variables {s : finset α} {f : α → (ι →₀ A)} (i : ι)
variables (g : ι →₀ A) (k : ι → A → γ → B) (x : γ)

theorem finset.sum_apply' : (∑ k in s, f k) i = ∑ k in s, f k i :=
(finsupp.apply_add_hom i : (ι →₀ A) →+ A).map_sum f s

theorem finsupp.sum_apply' : g.sum k x = g.sum (λ i b, k i b x) :=
finset.sum_apply _ _ _

section
include h0 h1

open_locale classical

theorem finsupp.sum_sum_index' : (∑ x in s, f x).sum t = ∑ x in s, (f x).sum t :=
finset.induction_on s rfl $ λ a s has ih,
by simp_rw [finset.sum_insert has, finsupp.sum_add_index' h0 h1, ih]

end

section
variables {R S : Type*} [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]

lemma finsupp.sum_mul (b : S) (s : α →₀ R) {f : α → R → S} :
  (s.sum f) * b = s.sum (λ a c, (f a c) * b) :=
by simp only [finsupp.sum, finset.sum_mul]

lemma finsupp.mul_sum (b : S) (s : α →₀ R) {f : α → R → S} :
  b * (s.sum f) = s.sum (λ a c, b * (f a c)) :=
by simp only [finsupp.sum, finset.mul_sum]

end

namespace nat

/-- If `0 : ℕ` is not in the support of `f : ℕ →₀ ℕ` then `0 < ∏ x in f.support, x ^ (f x)`. -/
lemma prod_pow_pos_of_zero_not_mem_support {f : ℕ →₀ ℕ} (hf : 0 ∉ f.support) : 0 < f.prod pow :=
finset.prod_pos (λ a ha, pos_iff_ne_zero.mpr (pow_ne_zero _ (λ H, by {subst H, exact hf ha})))

end nat


/-
Copyright (c) 2021 Eric Weiser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.algebra.operations
import algebra.algebra.subalgebra.basic
import ring_theory.subring.pointwise
import ring_theory.adjoin.basic

/-!
# Pointwise actions on subalgebras.

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

If `R'` acts on an `R`-algebra `A` (so that `R'` and `R` actions commute)
then we get an `R'` action on the collection of `R`-subalgebras.
-/

namespace subalgebra

section pointwise
variables {R : Type*} {A : Type*} [comm_semiring R] [semiring A] [algebra R A]

theorem mul_to_submodule_le (S T : subalgebra R A) :
  S.to_submodule * T.to_submodule ≤ (S ⊔ T).to_submodule :=
begin
  rw submodule.mul_le,
  intros y hy z hz,
  show y * z ∈ (S ⊔ T),
  exact mul_mem (algebra.mem_sup_left hy) (algebra.mem_sup_right hz),
end

/-- As submodules, subalgebras are idempotent. -/
@[simp] theorem mul_self  (S : subalgebra R A) : S.to_submodule * S.to_submodule = S.to_submodule :=
begin
  apply le_antisymm,
  { refine (mul_to_submodule_le _ _).trans_eq _,
    rw sup_idem },
  { intros x hx1,
    rw ← mul_one x,
    exact submodule.mul_mem_mul hx1 (show (1 : A) ∈ S, from one_mem S) }
end

/-- When `A` is commutative, `subalgebra.mul_to_submodule_le` is strict. -/
theorem mul_to_submodule {R : Type*} {A : Type*} [comm_semiring R] [comm_semiring A] [algebra R A]
  (S T : subalgebra R A) :
  S.to_submodule * T.to_submodule = (S ⊔ T).to_submodule :=
begin
  refine le_antisymm (mul_to_submodule_le _ _) _,
  rintros x (hx : x ∈ algebra.adjoin R (S ∪ T : set A)),
  refine algebra.adjoin_induction hx (λ x hx, _) (λ r, _) (λ _ _, submodule.add_mem _)
    (λ x y hx hy, _),
  { cases hx with hxS hxT,
    { rw ← mul_one x,
      exact submodule.mul_mem_mul hxS (show (1 : A) ∈ T, from one_mem T) },
    { rw ← one_mul x,
      exact submodule.mul_mem_mul (show (1 : A) ∈ S, from one_mem S) hxT } },
  { rw ← one_mul (algebra_map _ _ _),
    exact submodule.mul_mem_mul (show (1 : A) ∈ S, from one_mem S) (algebra_map_mem _ _) },
  have := submodule.mul_mem_mul hx hy,
  rwa [mul_assoc, mul_comm _ T.to_submodule, ←mul_assoc _ _ S.to_submodule, mul_self,
    mul_comm T.to_submodule, ←mul_assoc, mul_self] at this,
end

variables {R' : Type*} [semiring R'] [mul_semiring_action R' A] [smul_comm_class R' R A]

/-- The action on a subalgebra corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action R' (subalgebra R A) :=
{ smul := λ a S, S.map (mul_semiring_action.to_alg_hom _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (alg_hom.ext $ by exact one_smul R')).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (alg_hom.ext $ by exact mul_smul _ _)).trans (S.map_map _ _).symm }

localized "attribute [instance] subalgebra.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (m : R') (S : subalgebra R A) : ↑(m • S) = m • (S : set A) := rfl

@[simp] lemma pointwise_smul_to_subsemiring (m : R') (S : subalgebra R A) :
  (m • S).to_subsemiring = m • S.to_subsemiring := rfl

@[simp] lemma pointwise_smul_to_submodule (m : R') (S : subalgebra R A) :
  (m • S).to_submodule = m • S.to_submodule := rfl

@[simp] lemma pointwise_smul_to_subring {R' R A : Type*} [semiring R'] [comm_ring R] [ring A]
  [mul_semiring_action R' A] [algebra R A] [smul_comm_class R' R A] (m : R') (S : subalgebra R A) :
  (m • S).to_subring = m • S.to_subring := rfl

lemma smul_mem_pointwise_smul (m : R') (r : A) (S : subalgebra R A) : r ∈ S → m • r ∈ m • S :=
(set.smul_mem_smul_set : _ → _ ∈ m • (S : set A))

end pointwise

end subalgebra


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import order.compactly_generated
import topology.sets.closeds

/-!
# Noetherian space

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

A Noetherian space is a topological space that satisfies any of the following equivalent conditions:
- `well_founded ((>) : opens α → opens α → Prop)`
- `well_founded ((<) : closeds α → closeds α → Prop)`
- `∀ s : set α, is_compact s`
- `∀ s : opens α, is_compact s`

The first is chosen as the definition, and the equivalence is shown in
`topological_space.noetherian_space_tfae`.

Many examples of noetherian spaces come from algebraic topology. For example, the underlying space
of a noetherian scheme (e.g., the spectrum of a noetherian ring) is noetherian.

## Main Results
- `noetherian_space.set`: Every subspace of a noetherian space is noetherian.
- `noetherian_space.is_compact`: Every subspace of a noetherian space is compact.
- `noetherian_space_tfae`: Describes the equivalent definitions of noetherian spaces.
- `noetherian_space.range`: The image of a noetherian space under a continuous map is noetherian.
- `noetherian_space.Union`: The finite union of noetherian spaces is noetherian.
- `noetherian_space.discrete`: A noetherian and hausdorff space is discrete.
- `noetherian_space.exists_finset_irreducible` : Every closed subset of a noetherian space is a
  finite union of irreducible closed subsets.
- `noetherian_space.finite_irreducible_components `: The number of irreducible components of a
  noetherian space is finite.

-/

variables (α β : Type*) [topological_space α] [topological_space β]

namespace topological_space

/-- Type class for noetherian spaces. It is defined to be spaces whose open sets satisfies ACC. -/
@[mk_iff]
class noetherian_space : Prop :=
(well_founded : well_founded ((>) : opens α → opens α → Prop))

lemma noetherian_space_iff_opens :
  noetherian_space α ↔ ∀ s : opens α, is_compact (s : set α) :=
begin
  rw [noetherian_space_iff, complete_lattice.well_founded_iff_is_Sup_finite_compact,
    complete_lattice.is_Sup_finite_compact_iff_all_elements_compact],
  exact forall_congr opens.is_compact_element_iff,
end

@[priority 100]
instance noetherian_space.compact_space [h : noetherian_space α] : compact_space α :=
⟨(noetherian_space_iff_opens α).mp h ⊤⟩

variables {α β}

protected lemma noetherian_space.is_compact [noetherian_space α] (s : set α) : is_compact s :=
begin
  refine is_compact_iff_finite_subcover.2 (λ ι U hUo hs, _),
  rcases ((noetherian_space_iff_opens α).mp ‹_›
    ⟨⋃ i, U i, is_open_Union hUo⟩).elim_finite_subcover U hUo set.subset.rfl with ⟨t, ht⟩,
  exact ⟨t, hs.trans ht⟩
end

protected lemma inducing.noetherian_space [noetherian_space α] {i : β → α} (hi : inducing i) :
  noetherian_space β :=
(noetherian_space_iff_opens _).2 $ λ s, hi.is_compact_iff.1 (noetherian_space.is_compact _)

instance noetherian_space.set [h : noetherian_space α] (s : set α) : noetherian_space s :=
inducing_coe.noetherian_space

variable (α)

example (α : Type*) : set α ≃o (set α)ᵒᵈ := by refine order_iso.compl (set α)

lemma noetherian_space_tfae :
  tfae [noetherian_space α,
    well_founded (λ s t : closeds α, s < t),
    ∀ s : set α, is_compact s,
    ∀ s : opens α, is_compact (s : set α)] :=
begin
  tfae_have : 1 ↔ 2,
  { refine (noetherian_space_iff _).trans (surjective.well_founded_iff opens.compl_bijective.2 _),
    exact λ s t, (order_iso.compl (set α)).lt_iff_lt.symm },
  tfae_have : 1 ↔ 4,
  { exact noetherian_space_iff_opens α },
  tfae_have : 1 → 3,
  { exact @noetherian_space.is_compact _ _ },
  tfae_have : 3 → 4,
  { exact λ H s, H s },
  tfae_finish
end

variables {α β}

instance {α} : noetherian_space (cofinite_topology α) :=
begin
  simp only [noetherian_space_iff_opens, is_compact_iff_ultrafilter_le_nhds,
    cofinite_topology.nhds_eq, ultrafilter.le_sup_iff],
  intros s f hs,
  rcases f.le_cofinite_or_eq_pure with hf|⟨a, rfl⟩,
  { rcases filter.nonempty_of_mem (filter.le_principal_iff.1 hs) with ⟨a, ha⟩,
    exact ⟨a, ha, or.inr hf⟩ },
  { exact ⟨a, filter.le_principal_iff.mp hs, or.inl le_rfl⟩ }
end

lemma noetherian_space_of_surjective [noetherian_space α] (f : α → β)
  (hf : continuous f) (hf' : function.surjective f) : noetherian_space β :=
begin
  rw noetherian_space_iff_opens,
  intro s,
  obtain ⟨t, e⟩ := set.image_surjective.mpr hf' s,
  exact e ▸ (noetherian_space.is_compact t).image hf,
end

lemma noetherian_space_iff_of_homeomorph (f : α ≃ₜ β) :
  noetherian_space α ↔ noetherian_space β :=
⟨λ h, @@noetherian_space_of_surjective _ _ h f f.continuous f.surjective,
  λ h, @@noetherian_space_of_surjective _ _ h f.symm f.symm.continuous f.symm.surjective⟩

lemma noetherian_space.range [noetherian_space α] (f : α → β) (hf : continuous f) :
  noetherian_space (set.range f) :=
noetherian_space_of_surjective (set.cod_restrict f _ set.mem_range_self) (by continuity)
  (λ ⟨a, b, h⟩, ⟨b, subtype.ext h⟩)

lemma noetherian_space_set_iff (s : set α) :
  noetherian_space s ↔ ∀ t ⊆ s, is_compact t :=
begin
  rw (noetherian_space_tfae s).out 0 2,
  split,
  { intros H t ht,
    have := embedding_subtype_coe.is_compact_iff_is_compact_image.mp (H (coe ⁻¹' t)),
    simpa [set.inter_eq_left_iff_subset.mpr ht] using this },
  { intros H t,
    refine embedding_subtype_coe.is_compact_iff_is_compact_image.mpr (H (coe '' t) _),
    simp }
end

@[simp] lemma noetherian_univ_iff :
  noetherian_space (set.univ : set α) ↔ noetherian_space α :=
noetherian_space_iff_of_homeomorph (homeomorph.set.univ α)

lemma noetherian_space.Union {ι : Type*} (f : ι → set α) [finite ι]
  [hf : ∀ i, noetherian_space (f i)] :
  noetherian_space (⋃ i, f i) :=
begin
  casesI nonempty_fintype ι,
  simp_rw noetherian_space_set_iff at hf ⊢,
  intros t ht,
  rw [← set.inter_eq_left_iff_subset.mpr ht, set.inter_Union],
  exact is_compact_Union (λ i, hf i _ (set.inter_subset_right _ _))
end

-- This is not an instance since it makes a loop with `t2_space_discrete`.
lemma noetherian_space.discrete [noetherian_space α] [t2_space α] : discrete_topology α :=
⟨eq_bot_iff.mpr (λ U _, is_closed_compl_iff.mp (noetherian_space.is_compact _).is_closed)⟩

local attribute [instance] noetherian_space.discrete

/-- Spaces that are both Noetherian and Hausdorff is finite. -/
lemma noetherian_space.finite [noetherian_space α] [t2_space α] : finite α :=
begin
  letI : fintype α :=
    set.fintype_of_finite_univ (noetherian_space.is_compact set.univ).finite_of_discrete,
  apply_instance
end

@[priority 100]
instance finite.to_noetherian_space [finite α] : noetherian_space α :=
⟨finite.well_founded_of_trans_of_irrefl _⟩

lemma noetherian_space.exists_finset_irreducible [noetherian_space α] (s : closeds α) :
  ∃ S : finset (closeds α), (∀ k : S, is_irreducible (k : set α)) ∧ s = S.sup id :=
begin
  classical,
  have := ((noetherian_space_tfae α).out 0 1).mp infer_instance,
  apply well_founded.induction this s, clear s,
  intros s H,
  by_cases h₁ : is_preirreducible s.1,
  cases h₂ : s.1.eq_empty_or_nonempty,
  { use ∅, refine ⟨λ k, k.2.elim, _⟩, rw finset.sup_empty, ext1, exact h },
  { use {s},
    simp only [coe_coe, finset.sup_singleton, id.def, eq_self_iff_true, and_true],
    rintro ⟨k, hk⟩,
    cases finset.mem_singleton.mp hk,
    exact ⟨h, h₁⟩ },
  { rw is_preirreducible_iff_closed_union_closed at h₁,
    push_neg at h₁,
    obtain ⟨z₁, z₂, hz₁, hz₂, h, hz₁', hz₂'⟩ := h₁,
    obtain ⟨S₁, hS₁, hS₁'⟩ := H (s ⊓ ⟨z₁, hz₁⟩) (inf_lt_left.2 hz₁'),
    obtain ⟨S₂, hS₂, hS₂'⟩ := H (s ⊓ ⟨z₂, hz₂⟩) (inf_lt_left.2 hz₂'),
    refine ⟨S₁ ∪ S₂, λ k, _, _⟩,
    { cases finset.mem_union.mp k.2 with h' h', exacts [hS₁ ⟨k, h'⟩, hS₂ ⟨k, h'⟩] },
    { rwa [finset.sup_union, ← hS₁', ← hS₂', ← inf_sup_left, left_eq_inf] } }
end

lemma noetherian_space.finite_irreducible_components [noetherian_space α] :
  (irreducible_components α).finite :=
begin
  classical,
  obtain ⟨S, hS₁, hS₂⟩ := noetherian_space.exists_finset_irreducible (⊤ : closeds α),
  suffices : irreducible_components α ⊆ coe '' (S : set $ closeds α),
  { exact set.finite.subset ((set.finite.intro infer_instance).image _) this },
  intros K hK,
  obtain ⟨z, hz, hz'⟩ : ∃ (z : set α) (H : z ∈ finset.image coe S), K ⊆ z,
  { convert is_irreducible_iff_sUnion_closed.mp
      hK.1 (S.image coe) _ _,
    { simp only [finset.mem_image, exists_prop, forall_exists_index, and_imp],
      rintro _ z hz rfl,
      exact z.2 },
    { exact (set.subset_univ _).trans ((congr_arg coe hS₂).trans $ by simp).subset } },
  obtain ⟨s, hs, e⟩ := finset.mem_image.mp hz,
  rw ← e at hz',
  refine ⟨s, hs, _⟩,
  symmetry,
  suffices : K ≤ s, { exact this.antisymm (hK.2 (hS₁ ⟨s, hs⟩) this) },
  simpa,
end

end topological_space