/-
Copyright (c) 2021 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Martin Zinkevich, Rémy Degenne

! This file was ported from Lean 3 source module measure_theory.pi_system
! leanprover-community/mathlib commit 98e83c3d541c77cdb7da20d79611a780ff8e7d90
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Encodable.Lattice
import Mathlib.MeasureTheory.MeasurableSpaceDef

/-!
# Induction principles for measurable sets, related to π-systems and λ-systems.

## Main statements

* The main theorem of this file is Dynkin's π-λ theorem, which appears
  here as an induction principle `induction_on_inter`. Suppose `s` is a
  collection of subsets of `α` such that the intersection of two members
  of `s` belongs to `s` whenever it is nonempty. Let `m` be the σ-algebra
  generated by `s`. In order to check that a predicate `C` holds on every
  member of `m`, it suffices to check that `C` holds on the members of `s` and
  that `C` is preserved by complementation and *disjoint* countable
  unions.

* The proof of this theorem relies on the notion of `IsPiSystem`, i.e., a collection of sets
  which is closed under binary non-empty intersections. Note that this is a small variation around
  the usual notion in the literature, which often requires that a π-system is non-empty, and closed
  also under disjoint intersections. This variation turns out to be convenient for the
  formalization.

* The proof of Dynkin's π-λ theorem also requires the notion of `DynkinSystem`, i.e., a collection
  of sets which contains the empty set, is closed under complementation and under countable union
  of pairwise disjoint sets. The disjointness condition is the only difference with `σ`-algebras.

* `generatePiSystem g` gives the minimal π-system containing `g`.
  This can be considered a Galois insertion into both measurable spaces and sets.

* `generateFrom_generatePiSystem_eq` proves that if you start from a collection of sets `g`,
  take the generated π-system, and then the generated σ-algebra, you get the same result as
  the σ-algebra generated from `g`. This is useful because there are connections between
  independent sets that are π-systems and the generated independent spaces.

* `mem_generatePiSystem_unionᵢ_elim` and `mem_generatePiSystem_unionᵢ_elim'` show that any
  element of the π-system generated from the union of a set of π-systems can be
  represented as the intersection of a finite number of elements from these sets.

* `piUnionᵢInter` defines a new π-system from a family of π-systems `π : ι → Set (Set α)` and a
  set of indices `S : Set ι`. `piUnionᵢInter π S` is the set of sets that can be written
  as `⋂ x ∈ t, f x` for some finset `t ∈ S` and sets `f x ∈ π x`.

## Implementation details

* `IsPiSystem` is a predicate, not a type. Thus, we don't explicitly define the galois
  insertion, nor do we define a complete lattice. In theory, we could define a complete
  lattice and galois insertion on the subtype corresponding to `IsPiSystem`.
-/

open MeasurableSpace Set

open Classical MeasureTheory

/-- A π-system is a collection of subsets of `α` that is closed under binary intersection of
  non-disjoint sets. Usually it is also required that the collection is nonempty, but we don't do
  that here. -/
def IsPiSystem {α} (C : Set (Set α)) : Prop :=
  ∀ᵉ (s ∈ C) (t ∈ C), (s ∩ t : Set α).Nonempty → s ∩ t ∈ C
#align is_pi_system IsPiSystem

namespace MeasurableSpace

theorem isPiSystem_measurableSet {α : Type _} [MeasurableSpace α] :
    IsPiSystem { s : Set α | MeasurableSet s } := fun _ hs _ ht _ => hs.inter ht
#align measurable_space.is_pi_system_measurable_set MeasurableSpace.isPiSystem_measurableSet

end MeasurableSpace

theorem IsPiSystem.singleton {α} (S : Set α) : IsPiSystem ({S} : Set (Set α)) := by
  intro s h_s t h_t _
  rw [Set.mem_singleton_iff.1 h_s, Set.mem_singleton_iff.1 h_t, Set.inter_self,
    Set.mem_singleton_iff]
#align is_pi_system.singleton IsPiSystem.singleton

theorem IsPiSystem.insert_empty {α} {S : Set (Set α)} (h_pi : IsPiSystem S) :
    IsPiSystem (insert ∅ S) := by
  intro s hs t ht hst
  cases' hs with hs hs
  · simp [hs]
  · cases' ht with ht ht
    · simp [ht]
    · exact Set.mem_insert_of_mem _ (h_pi s hs t ht hst)
#align is_pi_system.insert_empty IsPiSystem.insert_empty

theorem IsPiSystem.insert_univ {α} {S : Set (Set α)} (h_pi : IsPiSystem S) :
    IsPiSystem (insert Set.univ S) := by
  intro s hs t ht hst
  cases' hs with hs hs
  · cases' ht with ht ht <;> simp [hs, ht]
  · cases' ht with ht ht
    · simp [hs, ht]
    · exact Set.mem_insert_of_mem _ (h_pi s hs t ht hst)
#align is_pi_system.insert_univ IsPiSystem.insert_univ

theorem IsPiSystem.comap {α β} {S : Set (Set β)} (h_pi : IsPiSystem S) (f : α → β) :
    IsPiSystem { s : Set α | ∃ t ∈ S, f ⁻¹' t = s } := by
  rintro _ ⟨s, hs_mem, rfl⟩ _ ⟨t, ht_mem, rfl⟩ hst
  rw [← Set.preimage_inter] at hst⊢
  refine' ⟨s ∩ t, h_pi s hs_mem t ht_mem _, rfl⟩
  by_contra h
  rw [Set.not_nonempty_iff_eq_empty] at h
  rw [h] at hst
  simp at hst
#align is_pi_system.comap IsPiSystem.comap

theorem isPiSystem_unionᵢ_of_directed_le {α ι} (p : ι → Set (Set α))
    (hp_pi : ∀ n, IsPiSystem (p n)) (hp_directed : Directed (· ≤ ·) p) :
    IsPiSystem (⋃ n, p n) := by
  intro t1 ht1 t2 ht2 h
  rw [Set.mem_unionᵢ] at ht1 ht2⊢
  cases' ht1 with n ht1
  cases' ht2 with m ht2
  obtain ⟨k, hpnk, hpmk⟩ : ∃ k, p n ≤ p k ∧ p m ≤ p k := hp_directed n m
  exact ⟨k, hp_pi k t1 (hpnk ht1) t2 (hpmk ht2) h⟩
#align is_pi_system_Union_of_directed_le isPiSystem_unionᵢ_of_directed_le

theorem isPiSystem_unionᵢ_of_monotone {α ι} [SemilatticeSup ι] (p : ι → Set (Set α))
    (hp_pi : ∀ n, IsPiSystem (p n)) (hp_mono : Monotone p) : IsPiSystem (⋃ n, p n) :=
  isPiSystem_unionᵢ_of_directed_le p hp_pi (Monotone.directed_le hp_mono)
#align is_pi_system_Union_of_monotone isPiSystem_unionᵢ_of_monotone

section Order

variable {α : Type _} {ι ι' : Sort _} [LinearOrder α]

theorem isPiSystem_image_Iio (s : Set α) : IsPiSystem (Iio '' s) := by
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ -
  exact ⟨a ⊓ b, inf_ind a b ha hb, Iio_inter_Iio.symm⟩
#align is_pi_system_image_Iio isPiSystem_image_Iio

theorem isPiSystem_Iio : IsPiSystem (range Iio : Set (Set α)) :=
  @image_univ α _ Iio ▸ isPiSystem_image_Iio univ
#align is_pi_system_Iio isPiSystem_Iio

theorem isPiSystem_image_Ioi (s : Set α) : IsPiSystem (Ioi '' s) :=
  @isPiSystem_image_Iio αᵒᵈ _ s
#align is_pi_system_image_Ioi isPiSystem_image_Ioi

theorem isPiSystem_Ioi : IsPiSystem (range Ioi : Set (Set α)) :=
  @image_univ α _ Ioi ▸ isPiSystem_image_Ioi univ
#align is_pi_system_Ioi isPiSystem_Ioi

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ixx_mem {Ixx : α → α → Set α} {p : α → α → Prop}
    (Hne : ∀ {a b}, (Ixx a b).Nonempty → p a b)
    (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂)) (s t : Set α) :
    IsPiSystem { S | ∃ᵉ (l ∈ s) (u ∈ t), p l u ∧ Ixx l u = S } := by
  rintro _ ⟨l₁, hls₁, u₁, hut₁, _, rfl⟩ _ ⟨l₂, hls₂, u₂, hut₂, _, rfl⟩
  simp only [Hi]
  exact fun H => ⟨l₁ ⊔ l₂, sup_ind l₁ l₂ hls₁ hls₂, u₁ ⊓ u₂, inf_ind u₁ u₂ hut₁ hut₂, Hne H, rfl⟩
#align is_pi_system_Ixx_mem isPiSystem_Ixx_mem

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ixx {Ixx : α → α → Set α} {p : α → α → Prop}
    (Hne : ∀ {a b}, (Ixx a b).Nonempty → p a b)
    (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂)) (f : ι → α)
    (g : ι' → α) : @IsPiSystem α { S | ∃ i j, p (f i) (g j) ∧ Ixx (f i) (g j) = S } := by
  simpa only [exists_range_iff] using isPiSystem_Ixx_mem (@Hne) (@Hi) (range f) (range g)
#align is_pi_system_Ixx isPiSystem_Ixx

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ioo_mem (s t : Set α) :
    IsPiSystem { S | ∃ᵉ (l ∈ s) (u ∈ t), l < u ∧ Ioo l u = S } :=
  isPiSystem_Ixx_mem (Ixx := Ioo) (fun ⟨_, hax, hxb⟩ => hax.trans hxb) Ioo_inter_Ioo s t
#align is_pi_system_Ioo_mem isPiSystem_Ioo_mem

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ioo (f : ι → α) (g : ι' → α) :
    @IsPiSystem α { S | ∃ l u, f l < g u ∧ Ioo (f l) (g u) = S } :=
  isPiSystem_Ixx (Ixx := Ioo) (fun ⟨_, hax, hxb⟩ => hax.trans hxb) Ioo_inter_Ioo f g
#align is_pi_system_Ioo isPiSystem_Ioo

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ioc_mem (s t : Set α) :
    IsPiSystem { S | ∃ᵉ (l ∈ s) (u ∈ t), l < u ∧ Ioc l u = S } :=
  isPiSystem_Ixx_mem (Ixx := Ioc) (fun ⟨_, hax, hxb⟩ => hax.trans_le hxb) Ioc_inter_Ioc s t
#align is_pi_system_Ioc_mem isPiSystem_Ioc_mem

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ioc (f : ι → α) (g : ι' → α) :
    @IsPiSystem α { S | ∃ i j, f i < g j ∧ Ioc (f i) (g j) = S } :=
  isPiSystem_Ixx (Ixx := Ioc) (fun ⟨_, hax, hxb⟩ => hax.trans_le hxb) Ioc_inter_Ioc f g
#align is_pi_system_Ioc isPiSystem_Ioc

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ico_mem (s t : Set α) :
    IsPiSystem { S | ∃ᵉ (l ∈ s) (u ∈ t), l < u ∧ Ico l u = S } :=
  isPiSystem_Ixx_mem (Ixx := Ico) (fun ⟨_, hax, hxb⟩ => hax.trans_lt hxb) Ico_inter_Ico s t
#align is_pi_system_Ico_mem isPiSystem_Ico_mem

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Ico (f : ι → α) (g : ι' → α) :
    @IsPiSystem α { S | ∃ i j, f i < g j ∧ Ico (f i) (g j) = S } :=
  isPiSystem_Ixx (Ixx := Ico) (fun ⟨_, hax, hxb⟩ => hax.trans_lt hxb) Ico_inter_Ico f g
#align is_pi_system_Ico isPiSystem_Ico

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Icc_mem (s t : Set α) :
    IsPiSystem { S | ∃ᵉ (l ∈ s) (u ∈ t), l ≤ u ∧ Icc l u = S } :=
  isPiSystem_Ixx_mem (Ixx := Icc) nonempty_Icc.1 (by exact Icc_inter_Icc) s t
#align is_pi_system_Icc_mem isPiSystem_Icc_mem

-- porting note: change `∃ (_ : p l u), _` to `_ ∧ _`
theorem isPiSystem_Icc (f : ι → α) (g : ι' → α) :
    @IsPiSystem α { S | ∃ i j, f i ≤ g j ∧ Icc (f i) (g j) = S } :=
  isPiSystem_Ixx (Ixx := Icc) nonempty_Icc.1 (by exact Icc_inter_Icc) f g
#align is_pi_system_Icc isPiSystem_Icc

end Order

/-- Given a collection `S` of subsets of `α`, then `generatePiSystem S` is the smallest
π-system containing `S`. -/
inductive generatePiSystem {α} (S : Set (Set α)) : Set (Set α)
  | base {s : Set α} (h_s : s ∈ S) : generatePiSystem S s
  | inter {s t : Set α} (h_s : generatePiSystem S s) (h_t : generatePiSystem S t)
    (h_nonempty : (s ∩ t).Nonempty) : generatePiSystem S (s ∩ t)
#align generate_pi_system generatePiSystem

theorem isPiSystem_generatePiSystem {α} (S : Set (Set α)) : IsPiSystem (generatePiSystem S) :=
  fun _ h_s _ h_t h_nonempty => generatePiSystem.inter h_s h_t h_nonempty
#align is_pi_system_generate_pi_system isPiSystem_generatePiSystem

theorem subset_generatePiSystem_self {α} (S : Set (Set α)) : S ⊆ generatePiSystem S := fun _ =>
  generatePiSystem.base
#align subset_generate_pi_system_self subset_generatePiSystem_self

theorem generatePiSystem_subset_self {α} {S : Set (Set α)} (h_S : IsPiSystem S) :
    generatePiSystem S ⊆ S := fun x h => by
  induction' h with _ h_s s u _ _ h_nonempty h_s h_u
  · exact h_s
  · exact h_S _ h_s _ h_u h_nonempty
#align generate_pi_system_subset_self generatePiSystem_subset_self

theorem generatePiSystem_eq {α} {S : Set (Set α)} (h_pi : IsPiSystem S) : generatePiSystem S = S :=
  Set.Subset.antisymm (generatePiSystem_subset_self h_pi) (subset_generatePiSystem_self S)
#align generate_pi_system_eq generatePiSystem_eq

theorem generatePiSystem_mono {α} {S T : Set (Set α)} (hST : S ⊆ T) :
    generatePiSystem S ⊆ generatePiSystem T := fun t ht => by
  induction' ht with s h_s s u _ _ h_nonempty h_s h_u
  · exact generatePiSystem.base (Set.mem_of_subset_of_mem hST h_s)
  · exact isPiSystem_generatePiSystem T _ h_s _ h_u h_nonempty
#align generate_pi_system_mono generatePiSystem_mono

theorem generatePiSystem_measurableSet {α} [M : MeasurableSpace α] {S : Set (Set α)}
    (h_meas_S : ∀ s ∈ S, MeasurableSet s) (t : Set α) (h_in_pi : t ∈ generatePiSystem S) :
    MeasurableSet t := by
  induction' h_in_pi with s h_s s u _ _ _ h_s h_u
  · apply h_meas_S _ h_s
  · apply MeasurableSet.inter h_s h_u
#align generate_pi_system_measurable_set generatePiSystem_measurableSet

theorem generateFrom_measurableSet_of_generatePiSystem {α} {g : Set (Set α)} (t : Set α)
    (ht : t ∈ generatePiSystem g) : MeasurableSet[generateFrom g] t :=
  @generatePiSystem_measurableSet α (generateFrom g) g
    (fun _ h_s_in_g => measurableSet_generateFrom h_s_in_g) t ht
#align generate_from_measurable_set_of_generate_pi_system generateFrom_measurableSet_of_generatePiSystem

theorem generateFrom_generatePiSystem_eq {α} {g : Set (Set α)} :
    generateFrom (generatePiSystem g) = generateFrom g := by
  apply le_antisymm <;> apply generateFrom_le
  · exact fun t h_t => generateFrom_measurableSet_of_generatePiSystem t h_t
  · exact fun t h_t => measurableSet_generateFrom (generatePiSystem.base h_t)
#align generate_from_generate_pi_system_eq generateFrom_generatePiSystem_eq

/- Every element of the π-system generated by the union of a family of π-systems
is a finite intersection of elements from the π-systems.
For an indexed union version, see `mem_generatePiSystem_unionᵢ_elim'`. -/
theorem mem_generatePiSystem_unionᵢ_elim {α β} {g : β → Set (Set α)} (h_pi : ∀ b, IsPiSystem (g b))
    (t : Set α) (h_t : t ∈ generatePiSystem (⋃ b, g b)) :
    ∃ (T : Finset β) (f : β → Set α), (t = ⋂ b ∈ T, f b) ∧ ∀ b ∈ T, f b ∈ g b := by
  induction' h_t with s h_s s t' h_gen_s h_gen_t' h_nonempty h_s h_t'
  · rcases h_s with ⟨t', ⟨⟨b, rfl⟩, h_s_in_t'⟩⟩
    refine' ⟨{b}, fun _ => s, _⟩
    simpa using h_s_in_t'
  · rcases h_t' with ⟨T_t', ⟨f_t', ⟨rfl, h_t'⟩⟩⟩
    rcases h_s with ⟨T_s, ⟨f_s, ⟨rfl, h_s⟩⟩⟩
    use T_s ∪ T_t', fun b : β =>
      if b ∈ T_s then if b ∈ T_t' then f_s b ∩ f_t' b else f_s b
      else if b ∈ T_t' then f_t' b else (∅ : Set α)
    constructor
    · ext a
      simp_rw [Set.mem_inter_iff, Set.mem_interᵢ, Finset.mem_union, or_imp]
      rw [← forall_and]
      constructor <;> intro h1 b <;> by_cases hbs : b ∈ T_s <;> by_cases hbt : b ∈ T_t' <;>
          specialize h1 b <;>
        simp only [hbs, hbt, if_true, if_false, true_imp_iff, and_self_iff, false_imp_iff,
          and_true_iff, true_and_iff] at h1⊢
      all_goals exact h1
    intro b h_b
    -- Porting note: `simp only` required for a beta reduction
    simp only []
    split_ifs with hbs hbt hbt
    · refine' h_pi b (f_s b) (h_s b hbs) (f_t' b) (h_t' b hbt) (Set.Nonempty.mono _ h_nonempty)
      exact Set.inter_subset_inter (Set.binterᵢ_subset_of_mem hbs) (Set.binterᵢ_subset_of_mem hbt)
    · exact h_s b hbs
    · exact h_t' b hbt
    · rw [Finset.mem_union] at h_b
      apply False.elim (h_b.elim hbs hbt)
#align mem_generate_pi_system_Union_elim mem_generatePiSystem_unionᵢ_elim

/- Every element of the π-system generated by an indexed union of a family of π-systems
is a finite intersection of elements from the π-systems.
For a total union version, see `mem_generatePiSystem_unionᵢ_elim`. -/
theorem mem_generatePiSystem_unionᵢ_elim' {α β} {g : β → Set (Set α)} {s : Set β}
    (h_pi : ∀ b ∈ s, IsPiSystem (g b)) (t : Set α) (h_t : t ∈ generatePiSystem (⋃ b ∈ s, g b)) :
    ∃ (T : Finset β) (f : β → Set α), ↑T ⊆ s ∧ (t = ⋂ b ∈ T, f b) ∧ ∀ b ∈ T, f b ∈ g b := by
  have : t ∈ generatePiSystem (⋃ b : Subtype s, (g ∘ Subtype.val) b) :=
    by
    suffices h1 : (⋃ b : Subtype s, (g ∘ Subtype.val) b) = ⋃ b ∈ s, g b
    · rwa [h1]
    ext x
    simp only [exists_prop, Set.mem_unionᵢ, Function.comp_apply, Subtype.exists, Subtype.coe_mk]
    rfl
  rcases @mem_generatePiSystem_unionᵢ_elim α (Subtype s) (g ∘ Subtype.val)
      (fun b => h_pi b.val b.property) t this with
    ⟨T, ⟨f, ⟨rfl, h_t'⟩⟩⟩
  refine'
    ⟨T.image (fun x : s => (x : β)),
      Function.extend (fun x : s => (x : β)) f fun _ : β => (∅ : Set α), by simp, _, _⟩
  · ext a
    constructor <;>
      · simp (config := { proj := false }) only
          [Set.mem_interᵢ, Subtype.forall, Finset.set_binterᵢ_finset_image]
        intro h1 b h_b h_b_in_T
        have h2 := h1 b h_b h_b_in_T
        revert h2
        rw [Subtype.val_injective.extend_apply]
        apply id
  · intros b h_b
    simp_rw [Finset.mem_image, exists_prop, Subtype.exists, exists_and_right, exists_eq_right]
      at h_b
    cases' h_b with h_b_w h_b_h
    have h_b_alt : b = (Subtype.mk b h_b_w).val := rfl
    rw [h_b_alt, Subtype.val_injective.extend_apply]
    apply h_t'
    apply h_b_h
#align mem_generate_pi_system_Union_elim' mem_generatePiSystem_unionᵢ_elim'

section UnionInter

variable {α ι : Type _}

/-! ### π-system generated by finite intersections of sets of a π-system family -/

/-- From a set of indices `S : Set ι` and a family of sets of sets `π : ι → Set (Set α)`,
define the set of sets that can be written as `⋂ x ∈ t, f x` for some finset `t ⊆ S` and sets
`f x ∈ π x`. If `π` is a family of π-systems, then it is a π-system. -/
def piUnionᵢInter (π : ι → Set (Set α)) (S : Set ι) : Set (Set α) :=
  { s : Set α |
    ∃ (t : Finset ι) (_ : ↑t ⊆ S) (f : ι → Set α) (_ : ∀ x, x ∈ t → f x ∈ π x), s = ⋂ x ∈ t, f x }
#align pi_Union_Inter piUnionᵢInter

theorem piUnionᵢInter_singleton (π : ι → Set (Set α)) (i : ι) :
    piUnionᵢInter π {i} = π i ∪ {univ} := by
  ext1 s
  simp only [piUnionᵢInter, exists_prop, mem_union]
  refine' ⟨_, fun h => _⟩
  · rintro ⟨t, hti, f, hfπ, rfl⟩
    simp only [subset_singleton_iff, Finset.mem_coe] at hti
    by_cases hi : i ∈ t
    · have ht_eq_i : t = {i} := by
        ext1 x
        rw [Finset.mem_singleton]
        exact ⟨fun h => hti x h, fun h => h.symm ▸ hi⟩
      simp only [ht_eq_i, Finset.mem_singleton, interᵢ_interᵢ_eq_left]
      exact Or.inl (hfπ i hi)
    · have ht_empty : t = ∅ := by
        ext1 x
        simp only [Finset.not_mem_empty, iff_false_iff]
        exact fun hx => hi (hti x hx ▸ hx)
      -- Porting note: `Finset.not_mem_empty` required
      simp [ht_empty, Finset.not_mem_empty, interᵢ_false, interᵢ_univ, Set.mem_singleton univ,
        or_true_iff]
  · cases' h with hs hs
    · refine' ⟨{i}, _, fun _ => s, ⟨fun x hx => _, _⟩⟩
      · rw [Finset.coe_singleton]
      · rw [Finset.mem_singleton] at hx
        rwa [hx]
      · simp only [Finset.mem_singleton, interᵢ_interᵢ_eq_left]
    · refine' ⟨∅, _⟩
      simpa only [Finset.coe_empty, subset_singleton_iff, mem_empty_iff_false, IsEmpty.forall_iff,
        imp_true_iff, Finset.not_mem_empty, interᵢ_false, interᵢ_univ, true_and_iff,
        exists_const] using hs
#align pi_Union_Inter_singleton piUnionᵢInter_singleton

theorem piUnionᵢInter_singleton_left (s : ι → Set α) (S : Set ι) :
    piUnionᵢInter (fun i => ({s i} : Set (Set α))) S =
      { s' : Set α | ∃ (t : Finset ι) (_ : ↑t ⊆ S), s' = ⋂ i ∈ t, s i } := by
  ext1 s'
  simp_rw [piUnionᵢInter, Set.mem_singleton_iff, exists_prop, Set.mem_setOf_eq]
  refine' ⟨fun h => _, fun ⟨t, htS, h_eq⟩ => ⟨t, htS, s, fun _ _ => rfl, h_eq⟩⟩
  obtain ⟨t, htS, f, hft_eq, rfl⟩ := h
  refine' ⟨t, htS, _⟩
  congr! 3
  apply hft_eq
  assumption
#align pi_Union_Inter_singleton_left piUnionᵢInter_singleton_left

theorem generateFrom_piUnionᵢInter_singleton_left (s : ι → Set α) (S : Set ι) :
    generateFrom (piUnionᵢInter (fun k => {s k}) S) = generateFrom { t | ∃ k ∈ S, s k = t } := by
  refine' le_antisymm (generateFrom_le _) (generateFrom_mono _)
  · rintro _ ⟨I, hI, f, hf, rfl⟩
    refine' Finset.measurableSet_binterᵢ _ fun m hm => measurableSet_generateFrom _
    exact ⟨m, hI hm, (hf m hm).symm⟩
  · rintro _ ⟨k, hk, rfl⟩
    refine' ⟨{k}, fun m hm => _, s, fun i _ => _, _⟩
    · rw [Finset.mem_coe, Finset.mem_singleton] at hm
      rwa [hm]
    · exact Set.mem_singleton _
    · simp only [Finset.mem_singleton, Set.interᵢ_interᵢ_eq_left]
#align generate_from_pi_Union_Inter_singleton_left generateFrom_piUnionᵢInter_singleton_left

/-- If `π` is a family of π-systems, then `piUnionᵢInter π S` is a π-system. -/
theorem isPiSystem_piUnionᵢInter (π : ι → Set (Set α)) (hpi : ∀ x, IsPiSystem (π x)) (S : Set ι) :
    IsPiSystem (piUnionᵢInter π S) := by
  rintro t1 ⟨p1, hp1S, f1, hf1m, ht1_eq⟩ t2 ⟨p2, hp2S, f2, hf2m, ht2_eq⟩ h_nonempty
  simp_rw [piUnionᵢInter, Set.mem_setOf_eq]
  let g n := ite (n ∈ p1) (f1 n) Set.univ ∩ ite (n ∈ p2) (f2 n) Set.univ
  have hp_union_ss : ↑(p1 ∪ p2) ⊆ S := by
    simp only [hp1S, hp2S, Finset.coe_union, union_subset_iff, and_self_iff]
  use p1 ∪ p2, hp_union_ss, g
  have h_inter_eq : t1 ∩ t2 = ⋂ i ∈ p1 ∪ p2, g i :=
    by
    rw [ht1_eq, ht2_eq]
    simp_rw [← Set.inf_eq_inter]
    ext1 x
    simp only [inf_eq_inter, mem_inter_iff, mem_interᵢ, Finset.mem_union]
    refine' ⟨fun h i _ => _, fun h => ⟨fun i hi1 => _, fun i hi2 => _⟩⟩
    · split_ifs with h_1 h_2 h_2
      exacts[⟨h.1 i h_1, h.2 i h_2⟩, ⟨h.1 i h_1, Set.mem_univ _⟩, ⟨Set.mem_univ _, h.2 i h_2⟩,
        ⟨Set.mem_univ _, Set.mem_univ _⟩]
    · specialize h i (Or.inl hi1)
      rw [if_pos hi1] at h
      exact h.1
    · specialize h i (Or.inr hi2)
      rw [if_pos hi2] at h
      exact h.2
  refine' ⟨fun n hn => _, h_inter_eq⟩
  simp only []
  split_ifs with hn1 hn2 h
  · refine' hpi n (f1 n) (hf1m n hn1) (f2 n) (hf2m n hn2) (Set.nonempty_iff_ne_empty.2 fun h => _)
    rw [h_inter_eq] at h_nonempty
    suffices h_empty : (⋂ i ∈ p1 ∪ p2, g i) = ∅
    exact (Set.not_nonempty_iff_eq_empty.mpr h_empty) h_nonempty
    refine' le_antisymm (Set.interᵢ_subset_of_subset n _) (Set.empty_subset _)
    refine' Set.interᵢ_subset_of_subset hn _
    simp_rw [if_pos hn1, if_pos hn2]
    exact h.subset
  · simp [hf1m n hn1]
  · simp [hf2m n h]
  · exact absurd hn (by simp [hn1, h])
#align is_pi_system_pi_Union_Inter isPiSystem_piUnionᵢInter

theorem piUnionᵢInter_mono_left {π π' : ι → Set (Set α)} (h_le : ∀ i, π i ⊆ π' i) (S : Set ι) :
    piUnionᵢInter π S ⊆ piUnionᵢInter π' S := fun _ ⟨t, ht_mem, ft, hft_mem_pi, h_eq⟩ =>
  ⟨t, ht_mem, ft, fun x hxt => h_le x (hft_mem_pi x hxt), h_eq⟩
#align pi_Union_Inter_mono_left piUnionᵢInter_mono_left

theorem piUnionᵢInter_mono_right {π : ι → Set (Set α)} {S T : Set ι} (hST : S ⊆ T) :
    piUnionᵢInter π S ⊆ piUnionᵢInter π T := fun _ ⟨t, ht_mem, ft, hft_mem_pi, h_eq⟩ =>
  ⟨t, ht_mem.trans hST, ft, hft_mem_pi, h_eq⟩
#align pi_Union_Inter_mono_right piUnionᵢInter_mono_right

theorem generateFrom_piUnionᵢInter_le {m : MeasurableSpace α} (π : ι → Set (Set α))
    (h : ∀ n, generateFrom (π n) ≤ m) (S : Set ι) : generateFrom (piUnionᵢInter π S) ≤ m := by
  refine' generateFrom_le _
  rintro t ⟨ht_p, _, ft, hft_mem_pi, rfl⟩
  refine' Finset.measurableSet_binterᵢ _ fun x hx_mem => (h x) _ _
  exact measurableSet_generateFrom (hft_mem_pi x hx_mem)
#align generate_from_pi_Union_Inter_le generateFrom_piUnionᵢInter_le

theorem subset_piUnionᵢInter {π : ι → Set (Set α)} {S : Set ι} {i : ι} (his : i ∈ S) :
    π i ⊆ piUnionᵢInter π S := by
  have h_ss : {i} ⊆ S := by
    intro j hj
    rw [mem_singleton_iff] at hj
    rwa [hj]
  refine' Subset.trans _ (piUnionᵢInter_mono_right h_ss)
  rw [piUnionᵢInter_singleton]
  exact subset_union_left _ _
#align subset_pi_Union_Inter subset_piUnionᵢInter

theorem mem_piUnionᵢInter_of_measurableSet (m : ι → MeasurableSpace α) {S : Set ι} {i : ι}
    (hiS : i ∈ S) (s : Set α) (hs : MeasurableSet[m i] s) :
    s ∈ piUnionᵢInter (fun n => { s | MeasurableSet[m n] s }) S :=
  subset_piUnionᵢInter hiS hs
#align mem_pi_Union_Inter_of_measurable_set mem_piUnionᵢInter_of_measurableSet

theorem le_generateFrom_piUnionᵢInter {π : ι → Set (Set α)} (S : Set ι) {x : ι} (hxS : x ∈ S) :
    generateFrom (π x) ≤ generateFrom (piUnionᵢInter π S) :=
  generateFrom_mono (subset_piUnionᵢInter hxS)
#align le_generate_from_pi_Union_Inter le_generateFrom_piUnionᵢInter

theorem measurableSet_supᵢ_of_mem_piUnionᵢInter (m : ι → MeasurableSpace α) (S : Set ι) (t : Set α)
    (ht : t ∈ piUnionᵢInter (fun n => { s | MeasurableSet[m n] s }) S) :
    MeasurableSet[⨆ i ∈ S, m i] t := by
  rcases ht with ⟨pt, hpt, ft, ht_m, rfl⟩
  refine' pt.measurableSet_binterᵢ fun i hi => _
  suffices h_le : m i ≤ ⨆ i ∈ S, m i; exact h_le (ft i) (ht_m i hi)
  have hi' : i ∈ S := hpt hi
  exact le_supᵢ₂ (f := fun i (_ : i ∈ S) => m i) i hi'
#align measurable_set_supr_of_mem_pi_Union_Inter measurableSet_supᵢ_of_mem_piUnionᵢInter

theorem generateFrom_piUnionᵢInter_measurableSet (m : ι → MeasurableSpace α) (S : Set ι) :
    generateFrom (piUnionᵢInter (fun n => { s | MeasurableSet[m n] s }) S) = ⨆ i ∈ S, m i := by
  refine' le_antisymm _ _
  · rw [← @generateFrom_measurableSet α (⨆ i ∈ S, m i)]
    exact generateFrom_mono (measurableSet_supᵢ_of_mem_piUnionᵢInter m S)
  · refine' supᵢ₂_le fun i hi => _
    rw [← @generateFrom_measurableSet α (m i)]
    exact generateFrom_mono (mem_piUnionᵢInter_of_measurableSet m hi)
#align generate_from_pi_Union_Inter_measurable_set generateFrom_piUnionᵢInter_measurableSet

end UnionInter

namespace MeasurableSpace

variable {α : Type _}

/-! ## Dynkin systems and Π-λ theorem -/

/-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
  is closed under complementation and under countable union of pairwise disjoint sets.
  The disjointness condition is the only difference with `σ`-algebras.

  The main purpose of Dynkin systems is to provide a powerful induction rule for σ-algebras
  generated by a collection of sets which is stable under intersection.

  A Dynkin system is also known as a "λ-system" or a "d-system".
-/
structure DynkinSystem (α : Type _) where
  /-- Predicate saying that a given set is contained in the Dynkin system. -/
  Has : Set α → Prop
  /-- A Dynkin system contains the empty set. -/
  has_empty : Has ∅
  /-- A Dynkin system is closed under complementation. -/
  has_compl : ∀ {a}, Has a → Has (aᶜ)
  /-- A Dynkin system is closed under countable union of pairwise disjoint sets. Use a more general
  `MeasurableSpace.DynkinSystem.has_unionᵢ` instead.-/
  has_unionᵢ_nat : ∀ {f : ℕ → Set α}, Pairwise (Disjoint on f) → (∀ i, Has (f i)) → Has (⋃ i, f i)
#align measurable_space.dynkin_system MeasurableSpace.DynkinSystem

namespace DynkinSystem

@[ext]
theorem ext : ∀ {d₁ d₂ : DynkinSystem α}, (∀ s : Set α, d₁.Has s ↔ d₂.Has s) → d₁ = d₂
  | ⟨s₁, _, _, _⟩, ⟨s₂, _, _, _⟩, h => by
    have : s₁ = s₂ := funext fun x => propext <| h x
    subst this
    rfl
#align measurable_space.dynkin_system.ext MeasurableSpace.DynkinSystem.ext

variable (d : DynkinSystem α)

theorem has_compl_iff {a} : d.Has (aᶜ) ↔ d.Has a :=
  ⟨fun h => by simpa using d.has_compl h, fun h => d.has_compl h⟩
#align measurable_space.dynkin_system.has_compl_iff MeasurableSpace.DynkinSystem.has_compl_iff

theorem has_univ : d.Has univ := by simpa using d.has_compl d.has_empty
#align measurable_space.dynkin_system.has_univ MeasurableSpace.DynkinSystem.has_univ

theorem has_unionᵢ {β} [Countable β] {f : β → Set α} (hd : Pairwise (Disjoint on f))
    (h : ∀ i, d.Has (f i)) : d.Has (⋃ i, f i) := by
  cases nonempty_encodable β
  rw [← Encodable.unionᵢ_decode₂]
  exact
    d.has_unionᵢ_nat (Encodable.unionᵢ_decode₂_disjoint_on hd) fun n =>
      Encodable.unionᵢ_decode₂_cases d.has_empty h
#align measurable_space.dynkin_system.has_Union MeasurableSpace.DynkinSystem.has_unionᵢ

theorem has_union {s₁ s₂ : Set α} (h₁ : d.Has s₁) (h₂ : d.Has s₂) (h : Disjoint s₁ s₂) :
    d.Has (s₁ ∪ s₂) := by
  rw [union_eq_unionᵢ]
  exact d.has_unionᵢ (pairwise_disjoint_on_bool.2 h) (Bool.forall_bool.2 ⟨h₂, h₁⟩)
#align measurable_space.dynkin_system.has_union MeasurableSpace.DynkinSystem.has_union

theorem has_diff {s₁ s₂ : Set α} (h₁ : d.Has s₁) (h₂ : d.Has s₂) (h : s₂ ⊆ s₁) : d.Has (s₁ \ s₂) :=
  by
  apply d.has_compl_iff.1
  simp [diff_eq, compl_inter]
  exact d.has_union (d.has_compl h₁) h₂ (disjoint_compl_left.mono_right h)
#align measurable_space.dynkin_system.has_diff MeasurableSpace.DynkinSystem.has_diff

instance : LE (DynkinSystem α) where le m₁ m₂ := m₁.Has ≤ m₂.Has

theorem le_def {α} {a b : DynkinSystem α} : a ≤ b ↔ a.Has ≤ b.Has :=
  Iff.rfl
#align measurable_space.dynkin_system.le_def MeasurableSpace.DynkinSystem.le_def

instance : PartialOrder (DynkinSystem α) :=
  { DynkinSystem.instLEDynkinSystem with
    le_refl := fun a b => le_rfl
    le_trans := fun a b c hab hbc => le_def.mpr (le_trans hab hbc)
    le_antisymm := fun a b h₁ h₂ => ext fun s => ⟨h₁ s, h₂ s⟩ }

/-- Every measurable space (σ-algebra) forms a Dynkin system -/
def ofMeasurableSpace (m : MeasurableSpace α) : DynkinSystem α
    where
  Has := m.MeasurableSet'
  has_empty := m.measurableSet_empty
  has_compl {a} := m.measurableSet_compl a
  has_unionᵢ_nat {f} _ hf := m.measurableSet_unionᵢ f hf
#align measurable_space.dynkin_system.of_measurable_space MeasurableSpace.DynkinSystem.ofMeasurableSpace

theorem ofMeasurableSpace_le_ofMeasurableSpace_iff {m₁ m₂ : MeasurableSpace α} :
    ofMeasurableSpace m₁ ≤ ofMeasurableSpace m₂ ↔ m₁ ≤ m₂ :=
  Iff.rfl
#align measurable_space.dynkin_system.of_measurable_space_le_of_measurable_space_iff MeasurableSpace.DynkinSystem.ofMeasurableSpace_le_ofMeasurableSpace_iff

/-- The least Dynkin system containing a collection of basic sets.
  This inductive type gives the underlying collection of sets. -/
inductive GenerateHas (s : Set (Set α)) : Set α → Prop
  | basic : ∀ t ∈ s, GenerateHas s t
  | empty : GenerateHas s ∅
  | compl : ∀ {a}, GenerateHas s a → GenerateHas s (aᶜ)
  | unionᵢ : ∀ {f : ℕ → Set α},
    Pairwise (Disjoint on f) → (∀ i, GenerateHas s (f i)) → GenerateHas s (⋃ i, f i)
#align measurable_space.dynkin_system.generate_has MeasurableSpace.DynkinSystem.GenerateHas

theorem generateHas_compl {C : Set (Set α)} {s : Set α} : GenerateHas C (sᶜ) ↔ GenerateHas C s := by
  refine' ⟨_, GenerateHas.compl⟩
  intro h
  convert GenerateHas.compl h
  simp
#align measurable_space.dynkin_system.generate_has_compl MeasurableSpace.DynkinSystem.generateHas_compl

/-- The least Dynkin system containing a collection of basic sets. -/
def generate (s : Set (Set α)) : DynkinSystem α
    where
  Has := GenerateHas s
  has_empty := GenerateHas.empty
  has_compl {_} := GenerateHas.compl
  has_unionᵢ_nat {_} := GenerateHas.unionᵢ
#align measurable_space.dynkin_system.generate MeasurableSpace.DynkinSystem.generate

theorem generateHas_def {C : Set (Set α)} : (generate C).Has = GenerateHas C :=
  rfl
#align measurable_space.dynkin_system.generate_has_def MeasurableSpace.DynkinSystem.generateHas_def

instance : Inhabited (DynkinSystem α) :=
  ⟨generate univ⟩

/-- If a Dynkin system is closed under binary intersection, then it forms a `σ`-algebra. -/
def toMeasurableSpace (h_inter : ∀ s₁ s₂, d.Has s₁ → d.Has s₂ → d.Has (s₁ ∩ s₂)) :
    MeasurableSpace α where
  MeasurableSet' := d.Has
  measurableSet_empty := d.has_empty
  measurableSet_compl s h := d.has_compl h
  measurableSet_unionᵢ f hf := by
    rw [← unionᵢ_disjointed]
    exact
      d.has_unionᵢ (disjoint_disjointed _) fun n =>
        disjointedRec (fun (t : Set α) i h => h_inter _ _ h <| d.has_compl <| hf i) (hf n)
#align measurable_space.dynkin_system.to_measurable_space MeasurableSpace.DynkinSystem.toMeasurableSpace

theorem ofMeasurableSpace_toMeasurableSpace
    (h_inter : ∀ s₁ s₂, d.Has s₁ → d.Has s₂ → d.Has (s₁ ∩ s₂)) :
    ofMeasurableSpace (d.toMeasurableSpace h_inter) = d :=
  ext fun _ => Iff.rfl
#align measurable_space.dynkin_system.of_measurable_space_to_measurable_space MeasurableSpace.DynkinSystem.ofMeasurableSpace_toMeasurableSpace

/-- If `s` is in a Dynkin system `d`, we can form the new Dynkin system `{s ∩ t | t ∈ d}`. -/
def restrictOn {s : Set α} (h : d.Has s) : DynkinSystem α where
  -- Porting note: `simp only []` required for a beta reduction
  Has t := d.Has (t ∩ s)
  has_empty := by simp [d.has_empty]
  has_compl {t} hts := by
    simp only []
    have : tᶜ ∩ s = (t ∩ s)ᶜ \ sᶜ := Set.ext fun x => by by_cases h : x ∈ s <;> simp [h]
    rw [this]
    exact
      d.has_diff (d.has_compl hts) (d.has_compl h)
        (compl_subset_compl.mpr <| inter_subset_right _ _)
  has_unionᵢ_nat {f} hd hf := by
    simp only []
    rw [unionᵢ_inter]
    refine' d.has_unionᵢ_nat _ hf
    exact hd.mono fun i j => Disjoint.mono (inter_subset_left _ _) (inter_subset_left _ _)
#align measurable_space.dynkin_system.restrict_on MeasurableSpace.DynkinSystem.restrictOn

theorem generate_le {s : Set (Set α)} (h : ∀ t ∈ s, d.Has t) : generate s ≤ d := fun _ ht =>
  ht.recOn h d.has_empty (fun {_} _ h => d.has_compl h) fun {_} hd _ hf => d.has_unionᵢ hd hf
#align measurable_space.dynkin_system.generate_le MeasurableSpace.DynkinSystem.generate_le

theorem generate_has_subset_generate_measurable {C : Set (Set α)} {s : Set α}
    (hs : (generate C).Has s) : MeasurableSet[generateFrom C] s :=
  generate_le (ofMeasurableSpace (generateFrom C)) (fun _ => measurableSet_generateFrom) s hs
#align measurable_space.dynkin_system.generate_has_subset_generate_measurable MeasurableSpace.DynkinSystem.generate_has_subset_generate_measurable

theorem generate_inter {s : Set (Set α)} (hs : IsPiSystem s) {t₁ t₂ : Set α}
    (ht₁ : (generate s).Has t₁) (ht₂ : (generate s).Has t₂) : (generate s).Has (t₁ ∩ t₂) :=
  have : generate s ≤ (generate s).restrictOn ht₂ :=
    generate_le _ fun s₁ hs₁ =>
      have : (generate s).Has s₁ := GenerateHas.basic s₁ hs₁
      have : generate s ≤ (generate s).restrictOn this :=
        generate_le _ fun s₂ hs₂ =>
          show (generate s).Has (s₂ ∩ s₁) from
            (s₂ ∩ s₁).eq_empty_or_nonempty.elim (fun h => h.symm ▸ GenerateHas.empty) fun h =>
              GenerateHas.basic _ <| hs _ hs₂ _ hs₁ h
      have : (generate s).Has (t₂ ∩ s₁) := this _ ht₂
      show (generate s).Has (s₁ ∩ t₂) by rwa [inter_comm]
  this _ ht₁
#align measurable_space.dynkin_system.generate_inter MeasurableSpace.DynkinSystem.generate_inter

/-- **Dynkin's π-λ theorem**:
  Given a collection of sets closed under binary intersections, then the Dynkin system it
  generates is equal to the σ-algebra it generates.
  This result is known as the π-λ theorem.
  A collection of sets closed under binary intersection is called a π-system (often requiring
  additionnally that is is non-empty, but we drop this condition in the formalization).
-/
theorem generateFrom_eq {s : Set (Set α)} (hs : IsPiSystem s) :
    generateFrom s = (generate s).toMeasurableSpace fun t₁ t₂ => generate_inter hs :=
  le_antisymm (generateFrom_le fun t ht => GenerateHas.basic t ht)
    (ofMeasurableSpace_le_ofMeasurableSpace_iff.mp <| by
      rw [ofMeasurableSpace_toMeasurableSpace]
      exact generate_le _ fun t ht => measurableSet_generateFrom ht)
#align measurable_space.dynkin_system.generate_from_eq MeasurableSpace.DynkinSystem.generateFrom_eq

end DynkinSystem

theorem induction_on_inter {C : Set α → Prop} {s : Set (Set α)} [m : MeasurableSpace α]
    (h_eq : m = generateFrom s) (h_inter : IsPiSystem s) (h_empty : C ∅) (h_basic : ∀ t ∈ s, C t)
    (h_compl : ∀ t, MeasurableSet t → C t → C (tᶜ))
    (h_union :
      ∀ f : ℕ → Set α,
        Pairwise (Disjoint on f) → (∀ i, MeasurableSet (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
    ∀ ⦃t⦄, MeasurableSet t → C t :=
  have eq : MeasurableSet = DynkinSystem.GenerateHas s := by
    rw [h_eq, DynkinSystem.generateFrom_eq h_inter]
    rfl
  fun t ht =>
  have : DynkinSystem.GenerateHas s t := by rwa [eq] at ht
  this.recOn h_basic h_empty
    (fun {t} ht =>
      h_compl t <| by
        rw [eq]
        exact ht)
    fun {f} hf ht =>
    h_union f hf fun i => by
      rw [eq]
      exact ht _
#align measurable_space.induction_on_inter MeasurableSpace.induction_on_inter

end MeasurableSpace


import algebra.order.positive.ring algebra.group_power.order data.nat.basic tactic.by_contra

/-! # IMO 2008 A1 (P4), Ring Version -/

namespace IMOSL
namespace IMO2008A1

lemma positive_pow_eq_pow {R : Type*} [linear_ordered_ring R]
  {n : ℕ} (h : 0 < n) {a b : {x : R // 0 < x}} : a ^ n = b ^ n ↔ a = b :=
  by simp_rw [← subtype.coe_inj, positive.coe_pow];
    exact pow_left_inj (le_of_lt a.2) (le_of_lt b.2) h

/-- Final solution, general ring version -/
theorem final_solution_general_ring {R : Type*} [linear_ordered_comm_ring R] :
  ∀ f : {x : R // 0 < x} → {x : R // 0 < x}, (∀ p q r s, p * q = r * s →
    (f p ^ 2 + f q ^ 2) * (r ^ 2 + s ^ 2) = (p ^ 2 + q ^ 2) * (f (r ^ 2) + f (s ^ 2)))
      ↔ (f = λ x, x) ∨ ∀ x, x * f x = 1 :=
begin
  ---- First deal with the `←` direction.
  intros f; symmetry; refine ⟨λ h p q r s h0, _, λ h, _⟩,
  { rcases h with rfl | h,
    refl,
    rw [← mul_right_inj (p ^ 2 * q ^ 2), ← mul_assoc, mul_add _ (f p ^ 2), mul_right_comm,
        ← mul_pow, h, mul_assoc, ← mul_pow q, h, one_pow, mul_one, one_mul, add_comm,
        mul_left_comm, mul_right_inj, ← mul_pow, h0, mul_pow, mul_add, mul_right_comm,
        h, one_mul, mul_assoc, h, mul_one, add_comm] },

  ---- Deduce `f(x^2) = f(x)^2` and `f(x) = x` or `x f(x) = 1`
  have h0 : ∀ x, f (x ^ 2) = f x ^ 2 :=
    λ x, by replace h := h x x x x rfl;
      rwa [mul_comm, mul_right_inj, ← two_mul, ← two_mul, mul_right_inj, eq_comm] at h,
  replace h := λ x y, h (x ^ 2) (y ^ 2) (x * y) (x * y) (by rw [← sq, mul_pow]),
  simp_rw [h0, ← mul_two, ← mul_assoc, mul_left_inj, ← pow_mul, two_mul] at h,
  replace h0 := h0 1,
  rw [one_pow, sq, self_eq_mul_left] at h0,
  have h1 : ∀ x, f x = x ∨ x * f x = 1 :=
  begin
    intros x; replace h := h x 1,
    rw [mul_one, h0, one_pow, mul_comm, mul_add_one, add_one_mul, pow_add,
        pow_add, mul_assoc, ← mul_assoc, ← mul_pow, mul_comm] at h,
    simp_rw [← subtype.coe_inj, positive.coe_add, positive.coe_mul] at h,
    rw [← eq_sub_iff_add_eq, add_sub_right_comm, ← sub_eq_iff_eq_add, ← mul_sub_one,
        ← mul_sub_one, ← sub_eq_zero, ← sub_mul, mul_eq_zero] at h,
    simp_rw [sub_eq_zero, subtype.coe_inj, positive_pow_eq_pow two_pos] at h,
    revert h; refine or.imp_right (λ h, _),
    rwa [eq_comm, ← positive.coe_one, subtype.coe_inj,
         ← one_pow 2, eq_comm, positive_pow_eq_pow two_pos] at h
  end,

  ---- Finishing
  rw function.funext_iff; by_contra' h2,
  rcases h2 with ⟨⟨a, h2⟩, b, h3⟩,
  have h4 := h1 b; rw or_iff_left h3 at h4,
  replace h := h a b; rw h4 at h,
  replace h4 := h1 (a * b); cases h4 with h4,
  rw [h4, mul_left_inj, add_left_inj, positive_pow_eq_pow four_pos] at h,
  exact h2 h,
  replace h1 := h1 a; rw or_iff_right h2 at h1,
  rw [← mul_right_inj ((a * b) ^ 2), mul_left_comm _ _ (f _ ^ 2), ← mul_pow,
      h4, one_pow, mul_one, mul_comm _ ((a * b) ^ 2), ← mul_assoc, ← pow_add,
      mul_pow, mul_add, mul_right_comm, ← mul_pow, h1, one_pow, one_mul, add_comm,
      add_left_inj, ← mul_pow, ← mul_pow, positive_pow_eq_pow four_pos, mul_assoc,
      mul_right_eq_self, ← sq, eq_comm, ← one_pow 2, positive_pow_eq_pow two_pos] at h,
  apply h3; subst h; rw [one_mul, h0]
end

end IMO2008A1
end IMOSL


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/

import algebra.algebra.basic
import algebra.category.CommRing.basic
import ring_theory.ideal.operations

/-!

# Local rings

Define local rings as commutative rings having a unique maximal ideal.

## Main definitions

* `local_ring`: A predicate on commutative rings, stating that every element `a` is either a unit
  or `1 - a` is a unit. This is shown to be equivalent to the condition that there exists a unique
  maximal ideal.
* `local_ring.maximal_ideal`: The unique maximal ideal for a local rings. Its carrier set is the set
  of non units.
* `is_local_ring_hom`: A predicate on semiring homomorphisms, requiring that it maps nonunits
  to nonunits. For local rings, this means that the image of the unique maximal ideal is again
  contained in the unique maximal ideal.
* `local_ring.residue_field`: The quotient of a local ring by its maximal ideal.

-/

universes u v w

/-- A commutative ring is local if it has a unique maximal ideal. Note that
  `local_ring` is a predicate. -/
class local_ring (R : Type u) [comm_ring R] extends nontrivial R : Prop :=
(is_local : ∀ (a : R), (is_unit a) ∨ (is_unit (1 - a)))

namespace local_ring

variables {R : Type u} [comm_ring R] [local_ring R]

lemma is_unit_or_is_unit_one_sub_self (a : R) :
  (is_unit a) ∨ (is_unit (1 - a)) :=
is_local a

lemma is_unit_of_mem_nonunits_one_sub_self (a : R) (h : (1 - a) ∈ nonunits R) :
  is_unit a :=
or_iff_not_imp_right.1 (is_local a) h

lemma is_unit_one_sub_self_of_mem_nonunits (a : R) (h : a ∈ nonunits R) :
  is_unit (1 - a) :=
or_iff_not_imp_left.1 (is_local a) h

lemma nonunits_add {x y} (hx : x ∈ nonunits R) (hy : y ∈ nonunits R) :
  x + y ∈ nonunits R :=
begin
  rintros ⟨u, hu⟩,
  apply hy,
  suffices : is_unit ((↑u⁻¹ : R) * y),
  { rcases this with ⟨s, hs⟩,
    use u * s,
    convert congr_arg (λ z, (u : R) * z) hs,
    rw ← mul_assoc, simp },
  rw show (↑u⁻¹ * y) = (1 - ↑u⁻¹ * x),
  { rw eq_sub_iff_add_eq,
    replace hu := congr_arg (λ z, (↑u⁻¹ : R) * z) hu.symm,
    simpa [mul_add, add_comm] using hu },
  apply is_unit_one_sub_self_of_mem_nonunits,
  exact mul_mem_nonunits_right hx
end

variable (R)

/-- The ideal of elements that are not units. -/
def maximal_ideal : ideal R :=
{ carrier := nonunits R,
  zero_mem' := zero_mem_nonunits.2 $ zero_ne_one,
  add_mem' := λ x y hx hy, nonunits_add hx hy,
  smul_mem' := λ a x, mul_mem_nonunits_right }

instance maximal_ideal.is_maximal : (maximal_ideal R).is_maximal :=
begin
  rw ideal.is_maximal_iff,
  split,
  { intro h, apply h, exact is_unit_one },
  { intros I x hI hx H,
    erw not_not at hx,
    rcases hx with ⟨u,rfl⟩,
    simpa using I.mul_mem_left ↑u⁻¹ H }
end

lemma maximal_ideal_unique :
  ∃! I : ideal R, I.is_maximal :=
⟨maximal_ideal R, maximal_ideal.is_maximal R,
  λ I hI, hI.eq_of_le (maximal_ideal.is_maximal R).1.1 $
  λ x hx, hI.1.1 ∘ I.eq_top_of_is_unit_mem hx⟩

variable {R}

lemma eq_maximal_ideal {I : ideal R} (hI : I.is_maximal) : I = maximal_ideal R :=
unique_of_exists_unique (maximal_ideal_unique R) hI $ maximal_ideal.is_maximal R

lemma le_maximal_ideal {J : ideal R} (hJ : J ≠ ⊤) : J ≤ maximal_ideal R :=
begin
  rcases ideal.exists_le_maximal J hJ with ⟨M, hM1, hM2⟩,
  rwa ←eq_maximal_ideal hM1
end

@[simp] lemma mem_maximal_ideal (x) :
  x ∈ maximal_ideal R ↔ x ∈ nonunits R := iff.rfl

end local_ring

variables {R : Type u} {S : Type v} {T : Type w}

lemma local_of_nonunits_ideal [comm_ring R] (hnze : (0:R) ≠ 1)
  (h : ∀ x y ∈ nonunits R, x + y ∈ nonunits R) : local_ring R :=
{ exists_pair_ne := ⟨0, 1, hnze⟩,
  is_local := λ x, or_iff_not_imp_left.mpr $ λ hx,
  begin
    by_contra H,
    apply h _ _ hx H,
    simp [-sub_eq_add_neg, add_sub_cancel'_right]
  end }

lemma local_of_unique_max_ideal [comm_ring R] (h : ∃! I : ideal R, I.is_maximal) :
  local_ring R :=
local_of_nonunits_ideal
(let ⟨I, Imax, _⟩ := h in (λ (H : 0 = 1), Imax.1.1 $ I.eq_top_iff_one.2 $ H ▸ I.zero_mem))
$ λ x y hx hy H,
let ⟨I, Imax, Iuniq⟩ := h in
let ⟨Ix, Ixmax, Hx⟩ := exists_max_ideal_of_mem_nonunits hx in
let ⟨Iy, Iymax, Hy⟩ := exists_max_ideal_of_mem_nonunits hy in
have xmemI : x ∈ I, from ((Iuniq Ix Ixmax) ▸ Hx),
have ymemI : y ∈ I, from ((Iuniq Iy Iymax) ▸ Hy),
Imax.1.1 $ I.eq_top_of_is_unit_mem (I.add_mem xmemI ymemI) H

lemma local_of_unique_nonzero_prime (R : Type u) [comm_ring R]
  (h : ∃! P : ideal R, P ≠ ⊥ ∧ ideal.is_prime P) : local_ring R :=
local_of_unique_max_ideal begin
  rcases h with ⟨P, ⟨hPnonzero, hPnot_top, _⟩, hPunique⟩,
  refine ⟨P, ⟨⟨hPnot_top, _⟩⟩, λ M hM, hPunique _ ⟨_, ideal.is_maximal.is_prime hM⟩⟩,
  { refine ideal.maximal_of_no_maximal (λ M hPM hM, ne_of_lt hPM _),
    exact (hPunique _ ⟨ne_bot_of_gt hPM, ideal.is_maximal.is_prime hM⟩).symm },
  { rintro rfl,
    exact hPnot_top (hM.1.2 P (bot_lt_iff_ne_bot.2 hPnonzero)) },
end

lemma local_of_surjective [comm_ring R] [local_ring R] [comm_ring S] [nontrivial S]
  (f : R →+* S) (hf : function.surjective f) :
  local_ring S :=
{ is_local :=
  begin
    intros b,
    obtain ⟨a, rfl⟩ := hf b,
    apply (local_ring.is_unit_or_is_unit_one_sub_self a).imp f.is_unit_map _,
    rw [← f.map_one, ← f.map_sub],
    apply f.is_unit_map,
  end,
  .. ‹nontrivial S› }

/-- A local ring homomorphism is a homomorphism between local rings
  such that the image of the maximal ideal of the source is contained within
  the maximal ideal of the target. -/
class is_local_ring_hom [semiring R] [semiring S] (f : R →+* S) : Prop :=
(map_nonunit : ∀ a, is_unit (f a) → is_unit a)

instance is_local_ring_hom_id (R : Type*) [semiring R] : is_local_ring_hom (ring_hom.id R) :=
{ map_nonunit := λ a, id }

@[simp] lemma is_unit_map_iff [semiring R] [semiring S] (f : R →+* S)
  [is_local_ring_hom f] (a) :
  is_unit (f a) ↔ is_unit a :=
⟨is_local_ring_hom.map_nonunit a, f.is_unit_map⟩

instance is_local_ring_hom_comp [semiring R] [semiring S] [semiring T]
  (g : S →+* T) (f : R →+* S) [is_local_ring_hom g] [is_local_ring_hom f] :
  is_local_ring_hom (g.comp f) :=
{ map_nonunit := λ a, is_local_ring_hom.map_nonunit a ∘ is_local_ring_hom.map_nonunit (f a) }

instance is_local_ring_hom_equiv [semiring R] [semiring S] (f : R ≃+* S) :
  is_local_ring_hom f.to_ring_hom :=
{ map_nonunit := λ a ha,
  begin
    convert f.symm.to_ring_hom.is_unit_map ha,
    rw ring_equiv.symm_to_ring_hom_apply_to_ring_hom_apply,
  end }

@[simp] lemma is_unit_of_map_unit [semiring R] [semiring S] (f : R →+* S) [is_local_ring_hom f]
  (a) (h : is_unit (f a)) : is_unit a :=
is_local_ring_hom.map_nonunit a h

theorem of_irreducible_map [semiring R] [semiring S] (f : R →+* S) [h : is_local_ring_hom f] {x : R}
  (hfx : irreducible (f x)) : irreducible x :=
⟨λ h, hfx.not_unit $ is_unit.map f.to_monoid_hom h, λ p q hx, let ⟨H⟩ := h in
or.imp (H p) (H q) $ hfx.is_unit_or_is_unit $ f.map_mul p q ▸ congr_arg f hx⟩

section
open category_theory

lemma is_local_ring_hom_of_iso {R S : CommRing} (f : R ≅ S) : is_local_ring_hom f.hom :=
{ map_nonunit := λ a ha,
  begin
    convert f.inv.is_unit_map ha,
    rw category_theory.coe_hom_inv_id,
  end }

@[priority 100] -- see Note [lower instance priority]
instance is_local_ring_hom_of_is_iso {R S : CommRing} (f : R ⟶ S) [is_iso f] :
  is_local_ring_hom f :=
is_local_ring_hom_of_iso (as_iso f)

end

section
open local_ring
variables [comm_ring R] [local_ring R] [comm_ring S] [local_ring S]
variables (f : R →+* S) [is_local_ring_hom f]

lemma map_nonunit (a : R) (h : a ∈ maximal_ideal R) : f a ∈ maximal_ideal S :=
λ H, h $ is_unit_of_map_unit f a H

end

namespace local_ring
variables [comm_ring R] [local_ring R] [comm_ring S] [local_ring S]

/--
A ring homomorphism between local rings is a local ring hom iff it reflects units,
i.e. any preimage of a unit is still a unit. https://stacks.math.columbia.edu/tag/07BJ
-/
theorem local_hom_tfae (f : R →+* S) :
  tfae [is_local_ring_hom f,
        f '' (maximal_ideal R).1 ⊆ maximal_ideal S,
        (maximal_ideal R).map f ≤ maximal_ideal S,
        maximal_ideal R ≤ (maximal_ideal S).comap f,
        (maximal_ideal S).comap f = maximal_ideal R] :=
begin
  tfae_have : 1 → 2, rintros _ _ ⟨a,ha,rfl⟩,
    resetI, exact map_nonunit f a ha,
  tfae_have : 2 → 4, exact set.image_subset_iff.1,
  tfae_have : 3 ↔ 4, exact ideal.map_le_iff_le_comap,
  tfae_have : 4 → 1, intro h, fsplit, exact λ x, not_imp_not.1 (@h x),
  tfae_have : 1 → 5, intro, resetI, ext,
    exact not_iff_not.2 (is_unit_map_iff f x),
  tfae_have : 5 → 4, exact λ h, le_of_eq h.symm,
  tfae_finish,
end

variable (R)
/-- The residue field of a local ring is the quotient of the ring by its maximal ideal. -/
def residue_field := R ⧸ maximal_ideal R

noncomputable instance residue_field.field : field (residue_field R) :=
ideal.quotient.field (maximal_ideal R)

noncomputable instance : inhabited (residue_field R) := ⟨37⟩

/-- The quotient map from a local ring to its residue field. -/
def residue : R →+* (residue_field R) :=
ideal.quotient.mk _

noncomputable instance residue_field.algebra : algebra R (residue_field R) := (residue R).to_algebra

namespace residue_field

variables {R S}
/-- The map on residue fields induced by a local homomorphism between local rings -/
noncomputable def map (f : R →+* S) [is_local_ring_hom f] :
  residue_field R →+* residue_field S :=
ideal.quotient.lift (maximal_ideal R) ((ideal.quotient.mk _).comp f) $
λ a ha,
begin
  erw ideal.quotient.eq_zero_iff_mem,
  exact map_nonunit f a ha
end

end residue_field

variables {R}

lemma ker_eq_maximal_ideal {K : Type*} [field K]
  (φ : R →+* K) (hφ : function.surjective φ) : φ.ker = maximal_ideal R :=
local_ring.eq_maximal_ideal $ φ.ker_is_maximal_of_surjective hφ

end local_ring

namespace field
variables [field R]

open_locale classical

@[priority 100] -- see Note [lower instance priority]
instance : local_ring R :=
{ is_local := λ a,
  if h : a = 0
  then or.inr (by rw [h, sub_zero]; exact is_unit_one)
  else or.inl $ is_unit.mk0 a h }

end field


import data.real.basic

-- BEGIN
example {x y : ℝ} (h : x ≤ y) : ¬ y ≤ x ↔ x ≠ y :=
begin
  split,
    intro h1,
    intro h2,
    rw h2 at h1,
    rw h2 at h,
    exact h1 h,
  intro h1,
  contrapose! h1,
  exact le_antisymm h h1,
end

-- Alternatively
example {x y : ℝ} (h : x ≤ y) : ¬ y ≤ x ↔ x ≠ y :=
begin
  split,
    intro h1,
    push_neg at h1,
    intro h2,
    rw h2 at h1,
    exact (lt_irrefl y) h1,
  intro h1,
  contrapose! h1,
  exact le_antisymm h h1,
end

-- Alternatively
example {x y : ℝ} (h : x ≤ y) : ¬ y ≤ x ↔ x ≠ y :=
begin
  split,
  { contrapose!,
    rintro rfl,
    reflexivity },
  contrapose!,
  exact le_antisymm h,
end

example {x y : ℝ} (h : x ≤ y) : ¬ y ≤ x ↔ x ≠ y :=
⟨λ h₀ h₁, h₀ (by rw h₁), λ h₀ h₁, h₀ (le_antisymm h h₁)⟩
-- END


theorem mul_left_cancel (a b c : mynat) (ha : a ≠ 0) : a * b = a * c → b = c :=
begin
induction c with d hd generalizing b,
rw mul_zero,
intro h,
cases (eq_zero_or_eq_zero_of_mul_eq_zero _ _ h) with h1 h2,
exfalso,
apply ha,
exact h1,
exact h2,
intro hb,
cases b,
rw mul_zero at hb,
exfalso,
apply ha,
symmetry at hb,
cases (eq_zero_or_eq_zero_of_mul_eq_zero _ _ hb) with h1 h2,
exact h1,
exfalso,
exact succ_ne_zero _ h2,
have h : b = d,
apply hd,
rw mul_succ at hb,
rw mul_succ at hb,
exact add_right_cancel _ _ _ hb,
rwa h,
end


inductive naravno : Type    -- type naravno =
| nic : naravno             -- | Nic
| nasl : naravno -> naravno -- | Nasl of naravno

def plus : naravno -> naravno -> naravno
| naravno.nic      m := m
| (naravno.nasl m) n := naravno.nasl (plus m n)

theorem plus_assoc : forall m n p, plus (plus m n) p = plus m (plus n p) :=
  begin
    intros,
    induction m,
    case naravno.nic {
      unfold plus,
    },
    case naravno.nasl {
      unfold plus,
      rewrite m_ih,
    }
  end

-- P /\ Q  ... p * q
-- je_sodo 4 ... izjava
-- je_sodo  ... funkcija iz naravnih števil v izjave

inductive je_sodo : naravno -> Prop
| nic : je_sodo naravno.nic
| nasl_nasl {n} : je_sodo n -> je_sodo (naravno.nasl (naravno.nasl n))

#check je_sodo.nasl_nasl je_sodo.nic

lemma stiri_je_sodo : je_sodo (naravno.nasl (naravno.nasl (naravno.nasl (naravno.nasl naravno.nic)))) := begin
  apply je_sodo.nasl_nasl,
  apply je_sodo.nasl_nasl,
  apply je_sodo.nic,
end

theorem sodo_plus_sodo : forall m n, je_sodo m -> je_sodo n -> je_sodo (plus m n) :=
begin
  intros m n h_m h_n,
  induction h_m,
  case je_sodo.nic {
    unfold plus,
    assumption,
  },
  case je_sodo.nasl_nasl {
    rename h_m_n m',
    unfold plus,
    apply je_sodo.nasl_nasl,
    assumption,
  }
end

inductive manj_enako : naravno -> naravno -> Prop
| nic : forall m, manj_enako naravno.nic m
| nasl {m n} : manj_enako m n -> manj_enako (naravno.nasl m) (naravno.nasl n)

inductive manj_enako' : naravno -> naravno -> Prop
| refl : forall m, manj_enako' m m
| nasl : forall m n, manj_enako' m n -> manj_enako' m (naravno.nasl n)

theorem manj_enako_refl : forall m, manj_enako m m :=
begin
  intros,
  induction m,
  case naravno.nic {exact (manj_enako.nic naravno.nic)},
  case naravno.nasl {exact (manj_enako.nasl m_ih)},
end

theorem manj_enako_trans : forall m n, manj_enako m n -> forall p, manj_enako n p -> manj_enako m p :=
begin
  intros m n p h_m_manjse_n h_n_manjse_p,
  induction h_m_manjse_n,
  case manj_enako.nic {exact (manj_enako.nic p)},
  case manj_enako.nasl {
    rename h_m_manjse_n_m m',
    rename h_m_manjse_n_n n',
    cases h_n_manjse_p,
    rename h_n_manjse_p_n p',

  }
end

theorem manj_enako_refl' : forall m, manj_enako' m m :=
begin
  exact manj_enako'.refl
end


import data.set
import logic.basic

open set

namespace mth1001

section cartesian_product
-- In this file, we'll deal with two types, `U` and `V`.
variables (U : Type*) (V : Type*)
variables (S T : set U) (A B : set V)

/-
`U × V` is the (Cartesian) product type of `U` and `V`. It is the type of all pairs `(u,v)`, where
`u : U` and `v : V`.
-/
#check U × V

/-
WARNING: In Lean, the `×` symbol denotes the Cartesian product of types, not sets. However, we
can use the following special command to make Lean temporarily treat `×` as a set product.
-/
local notation a `×` b := set.prod a b

-- In addition to the results `mem_inter_iff`, `mem_union_eq`, `mem_diff` introduced in
-- the previous files, we'll use `mem_prod` to rewrite a product of two sets.

example (x : prod U V) : x ∈ (S × A) ↔ x.fst ∈ S ∧ x.snd ∈ A := by rw mem_prod

example : (S × (A ∪ B)) = (S × A) ∪ (S × B) :=
begin
  ext, -- Assume `x : U × V`. It suffices to prove `x ∈ (S × (A ∪ B)) ↔ x ∈ (S × A) ∪ (S × B)`.
  rw [mem_prod, mem_union_eq, mem_union_eq, mem_prod, mem_prod],
  rw and_or_distrib_left, -- Complete using left distributivity of `∧` over `∨`.
end

-- Exercise 139:
-- In this example, feel free to use the `tauto` tactic to finish the 'logic' part of the proof.
example : (S × (A ∩ B)) = (S × A) ∩  (S × B) :=
begin
  sorry
end

-- Exercise 140:
-- For this example, you'll either need De Morgan's law or the `tauto!` tactic which,
-- unlike `tauto`, is permitted to use classical reasoning.
example : (S × (A \ B)) = (S × A) \  (S × B) :=
begin
  sorry
end

end cartesian_product

end mth1001


/-
Copyright (c) 2022 Yaël Dillies, Ella Yu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Ella Yu
-/
import data.finset.prod
import data.fintype.prod

/-!
# Additive energy

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

This file defines the additive energy of two finsets of a group. This is a central quantity in
additive combinatorics.

## TODO

It's possibly interesting to have
`(s ×ˢ s) ×ˢ t ×ˢ t).filter (λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2)` (whose `card` is
`multiplicative_energy s t`) as a standalone definition.
-/

section
variables {α : Type*} [partial_order α] {x y : α}

end

variables {α : Type*} [decidable_eq α]

namespace finset
section has_mul
variables [has_mul α] {s s₁ s₂ t t₁ t₂ : finset α}

/-- The multiplicative energy of two finsets `s` and `t` in a group is the number of quadruples
`(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ * b₁ = a₂ * b₂`. -/
@[to_additive additive_energy "The additive energy of two finsets `s` and `t` in a group is the
number of quadruples `(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ + b₁ = a₂ + b₂`."]
def multiplicative_energy (s t : finset α) : ℕ :=
(((s ×ˢ s) ×ˢ t ×ˢ t).filter $ λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2).card

@[to_additive additive_energy_mono]
lemma multiplicative_energy_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) :
  multiplicative_energy s₁ t₁ ≤ multiplicative_energy s₂ t₂ :=
card_le_of_subset $ filter_subset_filter _ $ product_subset_product (product_subset_product hs hs) $
  product_subset_product ht ht

@[to_additive additive_energy_mono_left]
lemma multiplicative_energy_mono_left (hs : s₁ ⊆ s₂) :
  multiplicative_energy s₁ t ≤ multiplicative_energy s₂ t :=
multiplicative_energy_mono hs subset.rfl

@[to_additive additive_energy_mono_right]
lemma multiplicative_energy_mono_right (ht : t₁ ⊆ t₂) :
  multiplicative_energy s t₁ ≤ multiplicative_energy s t₂ :=
multiplicative_energy_mono subset.rfl ht

@[to_additive le_additive_energy]
lemma le_multiplicative_energy : s.card * t.card ≤ multiplicative_energy s t :=
begin
  rw ←card_product,
  refine card_le_card_of_inj_on (λ x, ((x.1, x.1), x.2, x.2)) (by simp [←and_imp]) (λ a _ b _, _),
  simp only [prod.mk.inj_iff, and_self, and_imp],
  exact prod.ext,
end

@[to_additive additive_energy_pos]
lemma multiplicative_energy_pos (hs : s.nonempty) (ht : t.nonempty) :
  0 < multiplicative_energy s t :=
(mul_pos hs.card_pos ht.card_pos).trans_le le_multiplicative_energy

variables (s t)

@[simp, to_additive additive_energy_empty_left]
lemma multiplicative_energy_empty_left : multiplicative_energy ∅ t = 0 :=
by simp [multiplicative_energy]

@[simp, to_additive additive_energy_empty_right]
lemma multiplicative_energy_empty_right : multiplicative_energy s ∅ = 0 :=
by simp [multiplicative_energy]

variables {s t}

@[simp, to_additive additive_energy_pos_iff]
lemma multiplicative_energy_pos_iff : 0 < multiplicative_energy s t ↔ s.nonempty ∧ t.nonempty :=
⟨λ h, of_not_not $ λ H, begin
  simp_rw [not_and_distrib, not_nonempty_iff_eq_empty] at H,
  obtain rfl | rfl := H; simpa [nat.not_lt_zero] using h,
end, λ h, multiplicative_energy_pos h.1 h.2⟩

@[simp, to_additive additive_energy_eq_zero_iff]
lemma multiplicative_energy_eq_zero_iff : multiplicative_energy s t = 0 ↔ s = ∅ ∨ t = ∅ :=
by simp [←(nat.zero_le _).not_gt_iff_eq, not_and_distrib]

end has_mul

section comm_monoid
variables [comm_monoid α]

@[to_additive additive_energy_comm]
lemma multiplicative_energy_comm (s t : finset α) :
  multiplicative_energy s t = multiplicative_energy t s :=
begin
  rw [multiplicative_energy, ←finset.card_map (equiv.prod_comm _ _).to_embedding, map_filter],
  simp [-finset.card_map, eq_comm, multiplicative_energy, mul_comm, map_eq_image, function.comp],
end

end comm_monoid

section comm_group
variables [comm_group α] [fintype α] (s t : finset α)

@[simp, to_additive additive_energy_univ_left]
lemma multiplicative_energy_univ_left :
  multiplicative_energy univ t = fintype.card α * t.card ^ 2 :=
begin
  simp only [multiplicative_energy, univ_product_univ, fintype.card, sq, ←card_product],
  set f : α × α × α → (α × α) × α × α := λ x, ((x.1 * x.2.2, x.1 * x.2.1), x.2) with hf,
  have : (↑((univ : finset α) ×ˢ t ×ˢ t) : set (α × α × α)).inj_on f,
  { rintro ⟨a₁, b₁, c₁⟩ h₁ ⟨a₂, b₂, c₂⟩ h₂ h,
    simp_rw prod.ext_iff at h,
    obtain ⟨h, rfl, rfl⟩ := h,
    rw mul_right_cancel h.1 },
  rw [←card_image_of_inj_on this],
  congr' with a,
  simp only [hf, mem_filter, mem_product, mem_univ, true_and, mem_image, exists_prop, prod.exists],
  refine ⟨λ h, ⟨a.1.1 * a.2.2⁻¹, _, _, h.1, by simp [mul_right_comm, h.2]⟩, _⟩,
  rintro ⟨b, c, d, hcd, rfl⟩,
  simpa [mul_right_comm],
end

@[simp, to_additive additive_energy_univ_right]
lemma multiplicative_energy_univ_right :
  multiplicative_energy s univ = fintype.card α * s.card ^ 2 :=
by rw [multiplicative_energy_comm, multiplicative_energy_univ_left]

end comm_group
end finset


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import ring_theory.localization.basic

/-!
# Integer elements of a localization

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

## Main definitions

 * `is_localization.is_integer` is a predicate stating that `x : S` is in the image of `R`

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variables {R : Type*} [comm_ring R] {M : submonoid R} {S : Type*} [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]

open function
open_locale big_operators

namespace is_localization

section

variables (R) {M S}

-- TODO: define a subalgebra of `is_integer`s
/-- Given `a : S`, `S` a localization of `R`, `is_integer R a` iff `a` is in the image of
the localization map from `R` to `S`. -/
def is_integer (a : S) : Prop := a ∈ (algebra_map R S).range

end

lemma is_integer_zero : is_integer R (0 : S) := subring.zero_mem _
lemma is_integer_one : is_integer R (1 : S) := subring.one_mem _

lemma is_integer_add {a b : S} (ha : is_integer R a) (hb : is_integer R b) :
  is_integer R (a + b) :=
subring.add_mem _ ha hb

lemma is_integer_mul {a b : S} (ha : is_integer R a) (hb : is_integer R b) :
  is_integer R (a * b) :=
subring.mul_mem _ ha hb

lemma is_integer_smul {a : R} {b : S} (hb : is_integer R b) :
  is_integer R (a • b) :=
begin
  rcases hb with ⟨b', hb⟩,
  use a * b',
  rw [←hb, (algebra_map R S).map_mul, algebra.smul_def]
end

variables (M) {S} [is_localization M S]

/-- Each element `a : S` has an `M`-multiple which is an integer.

This version multiplies `a` on the right, matching the argument order in `localization_map.surj`.
-/
lemma exists_integer_multiple' (a : S) :
  ∃ (b : M), is_integer R (a * algebra_map R S b) :=
let ⟨⟨num, denom⟩, h⟩ := is_localization.surj _ a in ⟨denom, set.mem_range.mpr ⟨num, h.symm⟩⟩

/-- Each element `a : S` has an `M`-multiple which is an integer.

This version multiplies `a` on the left, matching the argument order in the `has_smul` instance.
-/
lemma exists_integer_multiple (a : S) :
  ∃ (b : M), is_integer R ((b : R) • a) :=
by { simp_rw [algebra.smul_def, mul_comm _ a], apply exists_integer_multiple' }

/-- We can clear the denominators of a `finset`-indexed family of fractions. -/
lemma exist_integer_multiples {ι : Type*} (s : finset ι) (f : ι → S) :
  ∃ (b : M), ∀ i ∈ s, is_localization.is_integer R ((b : R) • f i) :=
begin
  haveI := classical.prop_decidable,
  refine ⟨∏ i in s, (sec M (f i)).2, λ i hi, ⟨_, _⟩⟩,
  { exact (∏ j in s.erase i, (sec M (f j)).2) * (sec M (f i)).1 },
  rw [ring_hom.map_mul, sec_spec', ←mul_assoc, ←(algebra_map R S).map_mul, ← algebra.smul_def],
  congr' 2,
  refine trans _ ((submonoid.subtype M).map_prod _ _).symm,
  rw [mul_comm, ←finset.prod_insert (s.not_mem_erase i), finset.insert_erase hi],
  refl
end

/-- We can clear the denominators of a finite indexed family of fractions. -/
lemma exist_integer_multiples_of_finite {ι : Type*} [finite ι] (f : ι → S) :
  ∃ (b : M), ∀ i, is_localization.is_integer R ((b : R) • f i) :=
begin
  casesI nonempty_fintype ι,
  obtain ⟨b, hb⟩ := exist_integer_multiples M finset.univ f,
  exact ⟨b, λ i, hb i (finset.mem_univ _)⟩
end

/-- We can clear the denominators of a finite set of fractions. -/
lemma exist_integer_multiples_of_finset (s : finset S) :
  ∃ (b : M), ∀ a ∈ s, is_integer R ((b : R) • a) :=
exist_integer_multiples M s id

/-- A choice of a common multiple of the denominators of a `finset`-indexed family of fractions. -/
noncomputable
def common_denom {ι : Type*} (s : finset ι) (f : ι → S) : M :=
(exist_integer_multiples M s f).some

/-- The numerator of a fraction after clearing the denominators
of a `finset`-indexed family of fractions. -/
noncomputable
def integer_multiple {ι : Type*} (s : finset ι) (f : ι → S) (i : s) : R :=
((exist_integer_multiples M s f).some_spec i i.prop).some

@[simp]
lemma map_integer_multiple {ι : Type*} (s : finset ι) (f : ι → S) (i : s) :
  algebra_map R S (integer_multiple M s f i) = common_denom M s f • f i :=
((exist_integer_multiples M s f).some_spec _ i.prop).some_spec

/-- A choice of a common multiple of the denominators of a finite set of fractions. -/
noncomputable
def common_denom_of_finset (s : finset S) : M :=
common_denom M s id

/-- The finset of numerators after clearing the denominators of a finite set of fractions. -/
noncomputable
def finset_integer_multiple [decidable_eq R] (s : finset S) : finset R :=
s.attach.image (λ t, integer_multiple M s id t)

open_locale pointwise

lemma finset_integer_multiple_image [decidable_eq R] (s : finset S) :
  algebra_map R S '' (finset_integer_multiple M s) =
    common_denom_of_finset M s • s :=
begin
  delta finset_integer_multiple common_denom,
  rw finset.coe_image,
  ext,
  split,
  { rintro ⟨_, ⟨x, -, rfl⟩, rfl⟩,
    rw map_integer_multiple,
    exact set.mem_image_of_mem _ x.prop },
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨_, ⟨⟨x, hx⟩, s.mem_attach _, rfl⟩, map_integer_multiple M s id _⟩ }
end

end is_localization


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

import algebra.group_power.basic
import logic.function.iterate
import group_theory.perm.basic
import group_theory.group_action.opposite

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open function

variables {M : Type*} {N : Type*} {G : Type*} {H : Type*}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
lemma hom_coe_pow {F : Type*} [monoid F] (c : F → M → M) (h1 : c 1 = id)
  (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = (c f^[n])
| 0 := by { rw [pow_zero, h1], refl }
| (n + 1) := by rw [pow_succ, iterate_succ', hmul, hom_coe_pow]

namespace monoid_hom

section

variables [mul_one_class M] [mul_one_class N]

@[simp, to_additive]
theorem iterate_map_one (f : M →* M) (n : ℕ) : f^[n] 1 = 1 :=
iterate_fixed f.map_one n

@[simp, to_additive]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) :
  f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
semiconj₂.iterate f.map_mul n x y

end

variables [monoid M] [monoid N] [group G] [group H]

@[simp, to_additive]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) :
  f^[n] (x⁻¹) = (f^[n] x)⁻¹ :=
commute.iterate_left f.map_inv n x

@[simp, to_additive]
theorem iterate_map_div (f : G →* G) (n : ℕ) (x y) :
  f^[n] (x / y) = (f^[n] x) / (f^[n] y) :=
semiconj₂.iterate f.map_div n x y

theorem iterate_map_pow (f : M →* M) (n : ℕ) (a) (m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_pow x m) n a

theorem iterate_map_zpow (f : G →* G) (n : ℕ) (a) (m : ℤ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_zpow x m) n a

end monoid_hom

lemma monoid.End.coe_pow {M} [monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

-- we define these manually so that we can pick a better argument order
namespace add_monoid_hom
variables [add_monoid M] [add_group G]

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_pow n x m

attribute [to_additive, to_additive_reorder 5] monoid_hom.iterate_map_pow

theorem iterate_map_zsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_zpow n x m

attribute [to_additive, to_additive_reorder 5] monoid_hom.iterate_map_zpow

end add_monoid_hom

lemma add_monoid.End.coe_pow {A} [add_monoid A] (f : add_monoid.End A) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

namespace ring_hom

section semiring

variables {R : Type*} [semiring R] (f : R →+* R) (n : ℕ) (x y : R)

lemma coe_pow (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) f n

theorem iterate_map_one : f^[n] 1 = 1 := f.to_monoid_hom.iterate_map_one n

theorem iterate_map_zero : f^[n] 0 = 0 := f.to_add_monoid_hom.iterate_map_zero n

theorem iterate_map_add : f^[n] (x + y) = (f^[n] x) + (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_add n x y

theorem iterate_map_mul : f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
f.to_monoid_hom.iterate_map_mul n x y

theorem iterate_map_pow (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
f.to_monoid_hom.iterate_map_pow n a m

theorem iterate_map_smul (n m : ℕ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_smul n m x

end semiring

variables {R : Type*} [ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_sub n x y

theorem iterate_map_neg : f^[n] (-x) = -(f^[n] x) :=
f.to_add_monoid_hom.iterate_map_neg n x

theorem iterate_map_zsmul (n : ℕ) (m : ℤ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_zsmul n m x

end ring_hom

lemma equiv.perm.coe_pow {α : Type*} (f : equiv.perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
hom_coe_pow _ rfl (λ _ _, rfl) _ _

--what should be the namespace for this section?
section monoid

variables [monoid G] (a : G) (n : ℕ)

@[simp, to_additive] lemma smul_iterate [mul_action G H] :
  ((•) a : H → H)^[n] = (•) (a^n) :=
funext (λ b, nat.rec_on n (by rw [iterate_zero, id.def, pow_zero, one_smul])
  (λ n ih, by rw [iterate_succ', comp_app, ih, pow_succ, mul_smul]))

@[simp, to_additive] lemma mul_left_iterate : ((*) a)^[n] = (*) (a^n) :=
smul_iterate a n

@[simp, to_additive] lemma mul_right_iterate : (* a)^[n] = (* a ^ n) :=
smul_iterate (mul_opposite.op a) n

@[to_additive]
lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
by simp [mul_right_iterate]

end monoid

section semigroup

variables [semigroup G] {a b c : G}

@[to_additive]
lemma semiconj_by.function_semiconj_mul_left (h : semiconj_by a b c) :
  function.semiconj ((*)a) ((*)b) ((*)c) :=
λ j, by rw [← mul_assoc, h.eq, mul_assoc]

@[to_additive]
lemma commute.function_commute_mul_left (h : commute a b) :
  function.commute ((*)a) ((*)b) :=
semiconj_by.function_semiconj_mul_left h

@[to_additive]
lemma semiconj_by.function_semiconj_mul_right_swap (h : semiconj_by a b c) :
  function.semiconj (*a) (*c) (*b) :=
λ j, by simp_rw [mul_assoc, ← h.eq]

@[to_additive]
lemma commute.function_commute_mul_right (h : commute a b) :
  function.commute (*a) (*b) :=
semiconj_by.function_semiconj_mul_right_swap h

end semigroup


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import analysis.specific_limits.basic
import data.rat.denumerable
import data.set.intervals.image_preimage
import set_theory.cardinal.continuum

/-!
# The cardinality of the reals

This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 𝔠`.

We show that `#ℝ ≤ 𝔠` by noting that every real number is determined by a Cauchy-sequence of the
form `ℕ → ℚ`, which has cardinality `𝔠`. To show that `#ℝ ≥ 𝔠` we define an injection from
`{0, 1} ^ ℕ` to `ℝ` with `f ↦ Σ n, f n * (1 / 3) ^ n`.

We conclude that all intervals with distinct endpoints have cardinality continuum.

## Main definitions

* `cardinal.cantor_function` is the function that sends `f` in `{0, 1} ^ ℕ` to `ℝ` by
  `f ↦ Σ' n, f n * (1 / 3) ^ n`

## Main statements

* `cardinal.mk_real : #ℝ = 𝔠`: the reals have cardinality continuum.
* `cardinal.not_countable_real`: the universal set of real numbers is not countable.
  We can use this same proof to show that all the other sets in this file are not countable.
* 8 lemmas of the form `mk_Ixy_real` for `x,y ∈ {i,o,c}` state that intervals on the reals
  have cardinality continuum.

## Notation

* `𝔠` : notation for `cardinal.continuum` in locale `cardinal`, defined in `set_theory.continuum`.

## Tags
continuum, cardinality, reals, cardinality of the reals
-/

open nat set
open_locale cardinal
noncomputable theory

namespace cardinal

variables {c : ℝ} {f g : ℕ → bool} {n : ℕ}

/-- The body of the sum in `cantor_function`.
`cantor_function_aux c f n = c ^ n` if `f n = tt`;
`cantor_function_aux c f n = 0` if `f n = ff`. -/
def cantor_function_aux (c : ℝ) (f : ℕ → bool) (n : ℕ) : ℝ := cond (f n) (c ^ n) 0

@[simp] lemma cantor_function_aux_tt (h : f n = tt) : cantor_function_aux c f n = c ^ n :=
by simp [cantor_function_aux, h]

@[simp] lemma cantor_function_aux_ff (h : f n = ff) : cantor_function_aux c f n = 0 :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_nonneg (h : 0 ≤ c) : 0 ≤ cantor_function_aux c f n :=
by { cases h' : f n; simp [h'], apply pow_nonneg h }

lemma cantor_function_aux_eq (h : f n = g n) :
  cantor_function_aux c f n = cantor_function_aux c g n :=
by simp [cantor_function_aux, h]

lemma cantor_function_aux_succ (f : ℕ → bool) :
  (λ n, cantor_function_aux c f (n + 1)) = λ n, c * cantor_function_aux c (λ n, f (n + 1)) n :=
by { ext n, cases h : f (n + 1); simp [h, pow_succ] }

lemma summable_cantor_function (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  summable (cantor_function_aux c f) :=
begin
  apply (summable_geometric_of_lt_1 h1 h2).summable_of_eq_zero_or_self,
  intro n, cases h : f n; simp [h]
end

/-- `cantor_function c (f : ℕ → bool)` is `Σ n, f n * c ^ n`, where `tt` is interpreted as `1` and
`ff` is interpreted as `0`. It is implemented using `cantor_function_aux`. -/
def cantor_function (c : ℝ) (f : ℕ → bool) : ℝ := ∑' n, cantor_function_aux c f n

lemma cantor_function_le (h1 : 0 ≤ c) (h2 : c < 1) (h3 : ∀ n, f n → g n) :
  cantor_function c f ≤ cantor_function c g :=
begin
  apply tsum_le_tsum _ (summable_cantor_function f h1 h2) (summable_cantor_function g h1 h2),
  intro n, cases h : f n, simp [h, cantor_function_aux_nonneg h1],
  replace h3 : g n = tt := h3 n h, simp [h, h3]
end

lemma cantor_function_succ (f : ℕ → bool) (h1 : 0 ≤ c) (h2 : c < 1) :
  cantor_function c f = cond (f 0) 1 0 + c * cantor_function c (λ n, f (n+1)) :=
begin
  rw [cantor_function, tsum_eq_zero_add (summable_cantor_function f h1 h2)],
  rw [cantor_function_aux_succ, tsum_mul_left, cantor_function_aux, pow_zero],
  refl
end

/-- `cantor_function c` is strictly increasing with if `0 < c < 1/2`, if we endow `ℕ → bool` with a
lexicographic order. The lexicographic order doesn't exist for these infinitary products, so we
explicitly write out what it means. -/
lemma increasing_cantor_function (h1 : 0 < c) (h2 : c < 1 / 2) {n : ℕ} {f g : ℕ → bool}
  (hn : ∀(k < n), f k = g k) (fn : f n = ff) (gn : g n = tt) :
  cantor_function c f < cantor_function c g :=
begin
  have h3 : c < 1, { apply h2.trans, norm_num },
  induction n with n ih generalizing f g,
  { let f_max : ℕ → bool := λ n, nat.rec ff (λ _ _, tt) n,
    have hf_max : ∀n, f n → f_max n,
    { intros n hn, cases n, rw [fn] at hn, contradiction, apply rfl },
    let g_min : ℕ → bool := λ n, nat.rec tt (λ _ _, ff) n,
    have hg_min : ∀n, g_min n → g n,
    { intros n hn, cases n, rw [gn], apply rfl, contradiction },
    apply (cantor_function_le (le_of_lt h1) h3 hf_max).trans_lt,
    refine lt_of_lt_of_le _ (cantor_function_le (le_of_lt h1) h3 hg_min),
    have : c / (1 - c) < 1,
    { rw [div_lt_one, lt_sub_iff_add_lt],
      { convert add_lt_add h2 h2, norm_num },
      rwa sub_pos },
    convert this,
    { rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv,
          ←tsum_geometric_of_lt_1 (le_of_lt h1) h3],
      apply zero_add },
    { convert tsum_eq_single 0 _,
      { apply_instance },
      { intros n hn, cases n, contradiction, refl } } },
  rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3],
  rw [hn 0 $ zero_lt_succ n],
  apply add_lt_add_left, rw mul_lt_mul_left h1, exact ih (λ k hk, hn _ $ nat.succ_lt_succ hk) fn gn
end

/-- `cantor_function c` is injective if `0 < c < 1/2`. -/
lemma cantor_function_injective (h1 : 0 < c) (h2 : c < 1 / 2) :
  function.injective (cantor_function c) :=
begin
  intros f g hfg, classical, by_contra h, revert hfg,
  have : ∃n, f n ≠ g n,
  { rw [←not_forall], intro h', apply h, ext, apply h' },
  let n := nat.find this,
  have hn : ∀ (k : ℕ), k < n → f k = g k,
  { intros k hk, apply of_not_not, exact nat.find_min this hk },
  cases fn : f n,
  { apply ne_of_lt, refine increasing_cantor_function h1 h2 hn fn _,
    apply eq_tt_of_not_eq_ff, rw [←fn], apply ne.symm, exact nat.find_spec this },
  { apply ne_of_gt, refine increasing_cantor_function h1 h2 (λ k hk, (hn k hk).symm) _ fn,
    apply eq_ff_of_not_eq_tt, rw [←fn], apply ne.symm, exact nat.find_spec this }
end

/-- The cardinality of the reals, as a type. -/
lemma mk_real : #ℝ = 𝔠 :=
begin
  apply le_antisymm,
  { rw real.equiv_Cauchy.cardinal_eq,
    apply mk_quotient_le.trans, apply (mk_subtype_le _).trans_eq,
    rw [← power_def, mk_nat, mk_rat, aleph_0_power_aleph_0] },
  { convert mk_le_of_injective (cantor_function_injective _ _),
    rw [←power_def, mk_bool, mk_nat, two_power_aleph_0], exact 1 / 3, norm_num, norm_num }
end

/-- The cardinality of the reals, as a set. -/
lemma mk_univ_real : #(set.univ : set ℝ) = 𝔠 :=
by rw [mk_univ, mk_real]

/-- **Non-Denumerability of the Continuum**: The reals are not countable. -/
lemma not_countable_real : ¬ (set.univ : set ℝ).countable :=
by { rw [← mk_set_le_aleph_0, not_le, mk_univ_real], apply cantor }

/-- The cardinality of the interval (a, ∞). -/
lemma mk_Ioi_real (a : ℝ) : #(Ioi a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  rw [← not_lt], intro h,
  refine ne_of_lt _ mk_univ_real,
  have hu : Iio a ∪ {a} ∪ Ioi a = set.univ,
  { convert Iic_union_Ioi, exact Iio_union_right },
  rw ← hu,
  refine lt_of_le_of_lt (mk_union_le _ _) _,
  refine lt_of_le_of_lt (add_le_add_right (mk_union_le _ _) _) _,
  have h2 : (λ x, a + a - x) '' Ioi a = Iio a,
  { convert image_const_sub_Ioi _ _, simp },
  rw ← h2,
  refine add_lt_of_lt (cantor _).le _ h,
  refine add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _,
  rw mk_singleton,
  exact one_lt_aleph_0.trans (cantor _)
end

/-- The cardinality of the interval [a, ∞). -/
lemma mk_Ici_real (a : ℝ) : #(Ici a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioi_real a ▸ mk_le_mk_of_subset Ioi_subset_Ici_self)

/-- The cardinality of the interval (-∞, a). -/
lemma mk_Iio_real (a : ℝ) : #(Iio a) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h2 : (λ x, a + a - x) '' Iio a = Ioi a,
  { convert image_const_sub_Iio _ _, simp },
  exact mk_Ioi_real a ▸ h2 ▸ mk_image_le
end

/-- The cardinality of the interval (-∞, a]. -/
lemma mk_Iic_real (a : ℝ) : #(Iic a) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Iio_real a ▸ mk_le_mk_of_subset Iio_subset_Iic_self)

/-- The cardinality of the interval (a, b). -/
lemma mk_Ioo_real {a b : ℝ} (h : a < b) : #(Ioo a b) = 𝔠 :=
begin
  refine le_antisymm (mk_real ▸ mk_set_le _) _,
  have h1 : #((λ x, x - a) '' Ioo a b) ≤ #(Ioo a b) := mk_image_le,
  refine le_trans _ h1,
  rw [image_sub_const_Ioo, sub_self],
  replace h := sub_pos_of_lt h,
  have h2 : #(has_inv.inv '' Ioo 0 (b - a)) ≤ #(Ioo 0 (b - a)) := mk_image_le,
  refine le_trans _ h2,
  rw [image_inv, inv_Ioo_0_left h, mk_Ioi_real]
end

/-- The cardinality of the interval [a, b). -/

/-- The cardinality of the interval [a, b]. -/
lemma mk_Icc_real {a b : ℝ} (h : a < b) : #(Icc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Icc_self)

/-- The cardinality of the interval (a, b]. -/
lemma mk_Ioc_real {a b : ℝ} (h : a < b) : #(Ioc a b) = 𝔠 :=
le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ioc_self)

end cardinal


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.free_abelian_group
import Mathlib.ring_theory.subring
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Free rings

The theory of the free ring over a type.

## Main definitions

* `free_ring α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `free_ring α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `free_ring α →+* free_ring β` induced by `f`.

## Implementation details

`free_ring α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

/-- The free ring over a type `α`. -/
def free_ring (α : Type u) :=
  free_abelian_group (free_monoid α)

namespace free_ring

protected instance ring (α : Type u) : ring (free_ring α) :=
  free_abelian_group.ring (free_monoid α)

protected instance inhabited (α : Type u) : Inhabited (free_ring α) :=
  { default := 0 }

/-- The canonical map from α to `free_ring α`. -/
def of {α : Type u} (x : α) : free_ring α :=
  free_abelian_group.of [x]

theorem of_injective {α : Type u} : function.injective of :=
  function.injective.comp free_abelian_group.of_injective free_monoid.of_injective

protected theorem induction_on {α : Type u} {C : free_ring α → Prop} (z : free_ring α) (hn1 : C (-1)) (hb : ∀ (b : α), C (of b)) (ha : ∀ (x y : free_ring α), C x → C y → C (x + y)) (hm : ∀ (x y : free_ring α), C x → C y → C (x * y)) : C z := sorry

/-- The ring homomorphism `free_ring α →+* R` induced from a map `α → R`. -/
def lift {α : Type u} {R : Type v} [ring R] (f : α → R) : free_ring α →+* R :=
  ring_hom.mk (add_monoid_hom.to_fun (free_abelian_group.lift fun (L : List α) => list.prod (list.map f L))) sorry sorry
    sorry sorry

@[simp] theorem lift_of {α : Type u} {R : Type v} [ring R] (f : α → R) (x : α) : coe_fn (lift f) (of x) = f x :=
  Eq.trans (free_abelian_group.lift.of (fun (L : List α) => list.prod (list.map f L)) [x]) (one_mul (f x))

@[simp] theorem lift_comp_of {α : Type u} {R : Type v} [ring R] (f : free_ring α →+* R) : lift (⇑f ∘ of) = f := sorry

/-- The canonical ring homomorphism `free_ring α →+* free_ring β` generated by a map `α → β`. -/
def map {α : Type u} {β : Type v} (f : α → β) : free_ring α →+* free_ring β :=
  lift (of ∘ f)

@[simp] theorem map_of {α : Type u} {β : Type v} (f : α → β) (x : α) : coe_fn (map f) (of x) = of (f x) :=
  lift_of (of ∘ f) x


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

import number_theory.arithmetic_function
import number_theory.lucas_lehmer
import algebra.geom_sum
import ring_theory.multiplicity

/-!
# Perfect Numbers

This file proves Theorem 70 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

The theorem characterizes even perfect numbers.

Euclid proved that if `2 ^ (k + 1) - 1` is prime (these primes are known as Mersenne primes),
  then `2 ^ k * 2 ^ (k + 1) - 1` is perfect.

Euler proved the converse, that if `n` is even and perfect, then there exists `k` such that
  `n = 2 ^ k * 2 ^ (k + 1) - 1` and `2 ^ (k + 1) - 1` is prime.

## References
https://en.wikipedia.org/wiki/Euclid%E2%80%93Euler_theorem
-/

lemma odd_mersenne_succ (k : ℕ) : ¬ 2 ∣ mersenne (k + 1) :=
by simp [← even_iff_two_dvd, ← nat.even_add_one] with parity_simps

namespace nat
open arithmetic_function finset
open_locale arithmetic_function

lemma sigma_two_pow_eq_mersenne_succ (k : ℕ) : σ 1 (2 ^ k) = mersenne (k + 1) :=
by simp [sigma_one_apply, mersenne, prime_two, ← geom_sum_mul_add 1 (k+1)]

/-- Euclid's theorem that Mersenne primes induce perfect numbers -/
theorem perfect_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  perfect ((2 ^ k) * mersenne (k + 1)) :=
begin
  rw [perfect_iff_sum_divisors_eq_two_mul, ← mul_assoc, ← pow_succ, ← sigma_one_apply, mul_comm,
    is_multiplicative_sigma.map_mul_of_coprime
        (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)),
    sigma_two_pow_eq_mersenne_succ],
  { simp [pr, nat.prime_two, sigma_one_apply] },
  { apply mul_pos (pow_pos _ k) (mersenne_pos (nat.succ_pos k)),
    norm_num }
end

lemma ne_zero_of_prime_mersenne (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  k ≠ 0 :=
begin
  intro H,
  simpa [H, mersenne, not_prime_one] using pr,
end

theorem even_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  even ((2 ^ k) * mersenne (k + 1)) :=
by simp [ne_zero_of_prime_mersenne k pr] with parity_simps

lemma eq_two_pow_mul_odd {n : ℕ} (hpos : 0 < n) :
  ∃ (k m : ℕ), n = 2 ^ k * m ∧ ¬ even m :=
begin
  have h := (multiplicity.finite_nat_iff.2 ⟨nat.prime_two.ne_one, hpos⟩),
  cases multiplicity.pow_multiplicity_dvd h with m hm,
  use [(multiplicity 2 n).get h, m],
  refine ⟨hm, _⟩,
  rw even_iff_two_dvd,
  have hg := multiplicity.is_greatest' h (nat.lt_succ_self _),
  contrapose! hg,
  rcases hg with ⟨k, rfl⟩,
  apply dvd.intro k,
  rw [pow_succ', mul_assoc, ← hm],
end

/-- **Perfect Number Theorem**: Euler's theorem that even perfect numbers can be factored as a
  power of two times a Mersenne prime. -/
theorem eq_two_pow_mul_prime_mersenne_of_even_perfect {n : ℕ} (ev : even n) (perf : perfect n) :
  ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) :=
begin
  have hpos := perf.2,
  rcases eq_two_pow_mul_odd hpos with ⟨k, m, rfl, hm⟩,
  use k,
  rw even_iff_two_dvd at hm,
  rw [perfect_iff_sum_divisors_eq_two_mul hpos, ← sigma_one_apply,
    is_multiplicative_sigma.map_mul_of_coprime (nat.prime_two.coprime_pow_of_not_dvd hm).symm,
    sigma_two_pow_eq_mersenne_succ, ← mul_assoc, ← pow_succ] at perf,
  rcases nat.coprime.dvd_of_dvd_mul_left
    (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)) (dvd.intro _ perf) with ⟨j, rfl⟩,
  rw [← mul_assoc, mul_comm _ (mersenne _), mul_assoc] at perf,
  have h := mul_left_cancel₀ (ne_of_gt (mersenne_pos (nat.succ_pos _))) perf,
  rw [sigma_one_apply, sum_divisors_eq_sum_proper_divisors_add_self, ← succ_mersenne, add_mul,
    one_mul, add_comm] at h,
  have hj := add_left_cancel h,
  cases sum_proper_divisors_dvd (by { rw hj, apply dvd.intro_left (mersenne (k + 1)) rfl }),
  { have j1 : j = 1 := eq.trans hj.symm h_1,
    rw [j1, mul_one, sum_proper_divisors_eq_one_iff_prime] at h_1,
    simp [h_1, j1] },
  { have jcon := eq.trans hj.symm h_1,
    rw [← one_mul j, ← mul_assoc, mul_one] at jcon,
    have jcon2 := mul_right_cancel₀ _ jcon,
    { exfalso,
      cases k,
      { apply hm,
        rw [← jcon2, pow_zero, one_mul, one_mul] at ev,
        rw [← jcon2, one_mul],
        exact even_iff_two_dvd.mp ev },
      apply ne_of_lt _ jcon2,
      rw [mersenne, ← nat.pred_eq_sub_one, lt_pred_iff, ← pow_one (nat.succ 1)],
      apply pow_lt_pow (nat.lt_succ_self 1) (nat.succ_lt_succ (nat.succ_pos k)) },
    contrapose! hm,
    simp [hm] }
end

/-- The Euclid-Euler theorem characterizing even perfect numbers -/
theorem even_and_perfect_iff {n : ℕ} :
  (even n ∧ perfect n) ↔ ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) :=
begin
  split,
  { rintro ⟨ev, perf⟩,
    exact eq_two_pow_mul_prime_mersenne_of_even_perfect ev perf },
  { rintro ⟨k, pr, rfl⟩,
    exact ⟨even_two_pow_mul_mersenne_of_prime k pr, perfect_two_pow_mul_mersenne_of_prime k pr⟩ }
end

end nat


import tactic.basic
import algebra.order.monoid
import order.succ_pred.basic
open function

universe u
variable {α : Type u}

namespace with_top
variables {a b c d : with_top α}

-- Generalisations that are possible.

lemma not_top_le_coe' [has_le α] (a : α) : ¬ (⊤ : with_top α) ≤ ↑a :=
by simp [has_le.le, some_eq_coe]

lemma ne_top_of_lt' [has_lt α] (h : a < b) : a ≠ ⊤ :=
by { rintro rfl, simpa [has_lt.lt, some_eq_coe] using h }

lemma lt_top_of_ne_top [has_lt α] (h : a ≠ ⊤) : a < ⊤ :=
by { cases a, exact (h rfl).elim, exact some_lt_none _ }

lemma lt_top_iff_ne_top' [has_lt α] : a < ⊤ ↔ a ≠ ⊤ := ⟨λ H, ne_top_of_lt' H, lt_top_of_ne_top⟩

-- add_lt_add lemmas. Many, MANY options.

theorem add_lt_add_of_lt_of_lt_of_ne_left_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(hb : b ≠ ⊤) (hab : a < b) (hcd : c < d) : a + c < b + d :=
calc  a + c < b + c : with_top.add_lt_add_right (ne_top_of_lt hcd) hab
      ...   < b + d : with_top.add_lt_add_left hb hcd

theorem add_lt_add_of_lt_of_lt_of_ne_right_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(hd : d ≠ ⊤) (hab : a < b) (hcd : c < d) : a + c < b + d :=
calc  a + c < a + d : with_top.add_lt_add_left (ne_top_of_lt hab) hcd
      ...   < b + d : with_top.add_lt_add_right hd hab

theorem add_lt_add_of_lt_of_lt_of_cov_lt_cov_swap_lt [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
begin
  cases b,
  { cases d,
    { rw [none_eq_top, add_top, ← @top_add _ _ c],
      exact with_top.add_lt_add_right (ne_top_of_lt' hcd) hab },
    { exact add_lt_add_of_lt_of_lt_of_ne_right_top (coe_ne_top) hab hcd }
  },  exact add_lt_add_of_lt_of_lt_of_ne_left_top (coe_ne_top) hab hcd
end

theorem add_lt_add_of_lt_of_lt_cov_lt [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
calc  a + c < a + d : with_top.add_lt_add_left (ne_top_of_lt hab) hcd
      ...   ≤ b + d : add_le_add_right hab.le _

theorem add_lt_add_of_lt_of_lt_cov_swap_lt [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
calc  a + c < b + c : with_top.add_lt_add_right (ne_top_of_lt hcd) hab
      ...   ≤ b + d : add_le_add_left hcd.le b

theorem add_lt_add_of_le_of_lt_of_left_ne_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(ha : a ≠ ⊤) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
calc  a + c < a + d : with_top.add_lt_add_left ha hcd
      ...   ≤ b + d : add_le_add_right hab _

theorem add_lt_add_of_le_of_lt_of_right_ne_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(hb : b ≠ ⊤) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
calc  a + c ≤ b + c : add_le_add_right hab _
      ...   < b + d : with_top.add_lt_add_left hb hcd

theorem add_lt_add_of_lt_of_le_of_left_ne_top [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hc : c ≠ ⊤) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
calc  a + c < b + c : with_top.add_lt_add_right hc hab
      ...   ≤ b + d : add_le_add_left hcd _

theorem add_lt_add_of_lt_of_le_of_right_ne_top [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hd : d ≠ ⊤) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
calc  a + c ≤ a + d : add_le_add_left hcd _
      ...   < b + d : with_top.add_lt_add_right hd hab

end with_top

namespace with_bot
variables {a b c d : with_bot α}

lemma not_coe'_le_bot [has_le α] (a : α) : ¬ ↑a ≤ (⊥ : with_bot α) :=
@with_top.not_top_le_coe' (order_dual α) _ _

lemma ne_bot_of_gt' [has_lt α] (h : a < b) : b ≠ ⊥ :=
@with_top.ne_top_of_lt' (order_dual α) _ _ _ h

lemma lt_top_of_ne_top [has_lt α] (h : a ≠ ⊥) : ⊥ < a :=
@with_top.lt_top_of_ne_top (order_dual α) _ _ h

lemma lt_top_iff_ne_top' [has_lt α] : ⊥ < a ↔ a ≠ ⊥ :=
@with_top.lt_top_iff_ne_top' (order_dual α) _ _

-- add_lt_add lemmas. Many, MANY options.

theorem add_lt_add_of_lt_of_lt_of_ne_left_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(ha : a ≠ ⊥) (hab : a < b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_lt_of_ne_left_top (order_dual α) _ _ _ _ _ _ _ _ ha hab hcd

theorem add_lt_add_of_lt_of_lt_of_ne_right_top [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(hc : c ≠ ⊥) (hab : a < b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_lt_of_ne_right_top (order_dual α) _ _ _ _ _ _ _ _ hc hab hcd

theorem add_lt_add_of_lt_of_lt_of_cov_lt_cov_swap_lt [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_lt_of_cov_lt_cov_swap_lt (order_dual α) _ _ _ _ _ _ _ _ hab hcd

theorem add_lt_add_of_lt_of_lt_cov_lt [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_lt_cov_lt (order_dual α) _ _ _ _ _ _ _ _ hab hcd

theorem add_lt_add_of_lt_of_lt_cov_swap_lt [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hab : a < b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_lt_cov_swap_lt (order_dual α) _ _ _ _ _ _ _ _ hab hcd

theorem add_lt_add_of_le_of_lt_of_left_ne_bot [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(ha : a ≠ ⊥) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_le_of_lt_of_right_ne_top (order_dual α) _ _ _ _ _ _ _ _ ha hab hcd

theorem add_lt_add_of_le_of_lt_of_right_ne_bot [has_add α] [preorder α]
[covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (≤)]
(hb : b ≠ ⊥) (hab : a ≤ b) (hcd : c < d) : a + c < b + d :=
@with_top.add_lt_add_of_le_of_lt_of_left_ne_top (order_dual α) _ _ _ _ _ _ _ _ hb hab hcd

theorem add_lt_add_of_lt_of_le_of_left_ne_bot [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hc : c ≠ ⊥) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_le_of_right_ne_top (order_dual α) _ _ _ _ _ _ _ _ hc hab hcd

theorem add_lt_add_of_lt_of_le_of_right_ne_bot [has_add α] [preorder α]
[covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (<)]
(hd : d ≠ ⊥) (hab : a < b) (hcd : c ≤ d) : a + c < b + d :=
@with_top.add_lt_add_of_lt_of_le_of_left_ne_top (order_dual α) _ _ _ _ _ _ _ _ hd hab hcd

end with_bot