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

A computable model of hereditarily finite sets with atoms
(ZFA without infinity). This is useful for calculations in naive
set theory.
-/
import data.list.basic
import data.sigma

variables {α : Type*}

@[derive decidable_eq]
inductive {u} lists' (α : Type u) : bool → Type u
| atom : α → lists' ff
| nil : lists' tt
| cons' {b} : lists' b → lists' tt → lists' tt

def lists (α : Type*) := Σ b, lists' α b

namespace lists'

instance [inhabited α] : ∀ b, inhabited (lists' α b)
| tt := ⟨nil⟩
| ff := ⟨atom (default _)⟩

def cons : lists α → lists' α tt → lists' α tt
| ⟨b, a⟩ l := cons' a l

@[simp] def to_list : ∀ {b}, lists' α b → list (lists α)
| _ (atom a)    := []
| _ nil         := []
| _ (cons' a l) := ⟨_, a⟩ :: l.to_list

@[simp] theorem to_list_cons (a : lists α) (l) :
  to_list (cons a l) = a :: l.to_list :=
by cases a; simp [cons]

@[simp] def of_list : list (lists α) → lists' α tt
| []       := nil
| (a :: l) := cons a (of_list l)

@[simp] theorem to_of_list (l : list (lists α)) : to_list (of_list l) = l :=
by induction l; simp *

@[simp] theorem of_to_list : ∀ (l : lists' α tt), of_list (to_list l) = l :=
suffices ∀ b (h : tt = b) (l : lists' α b),
  let l' : lists' α tt := by rw h; exact l in
  of_list (to_list l') = l', from this _ rfl,
λ b h l, begin
  induction l, {cases h}, {exact rfl},
  case lists'.cons' : b a l IH₁ IH₂ {
    intro, change l' with cons' a l,
    simpa [cons] using IH₂ rfl }
end

end lists'

mutual inductive lists.equiv, lists'.subset
with lists.equiv : lists α → lists α → Prop
| refl (l) : lists.equiv l l
| antisymm {l₁ l₂ : lists' α tt} :
  lists'.subset l₁ l₂ → lists'.subset l₂ l₁ → lists.equiv ⟨_, l₁⟩ ⟨_, l₂⟩
with lists'.subset : lists' α tt → lists' α tt → Prop
| nil {l} : lists'.subset lists'.nil l
| cons {a a' l l'} : lists.equiv a a' → a' ∈ lists'.to_list l' →
  lists'.subset l l' → lists'.subset (lists'.cons a l) l'
local infix ~ := lists.equiv

namespace lists'

instance : has_subset (lists' α tt) := ⟨lists'.subset⟩

instance {b} : has_mem (lists α) (lists' α b) :=
⟨λ a l, ∃ a' ∈ l.to_list, a ~ a'⟩

theorem mem_def {b a} {l : lists' α b} :
  a ∈ l ↔ ∃ a' ∈ l.to_list, a ~ a' := iff.rfl

@[simp] theorem mem_cons {a y l} : a ∈ @cons α y l ↔ a ~ y ∨ a ∈ l :=
by simp [mem_def, or_and_distrib_right, exists_or_distrib]

theorem cons_subset {a} {l₁ l₂ : lists' α tt} :
  lists'.cons a l₁ ⊆ l₂ ↔ a ∈ l₂ ∧ l₁ ⊆ l₂ :=
begin
  refine ⟨λ h, _, λ ⟨⟨a', m, e⟩, s⟩, subset.cons e m s⟩,
  generalize_hyp h' : lists'.cons a l₁ = l₁' at h,
  cases h with l a' a'' l l' e m s, {cases a, cases h'},
  cases a, cases a', cases h', exact ⟨⟨_, m, e⟩, s⟩
end

theorem of_list_subset {l₁ l₂ : list (lists α)} (h : l₁ ⊆ l₂) :
  lists'.of_list l₁ ⊆ lists'.of_list l₂ :=
begin
  induction l₁, {exact subset.nil},
  refine subset.cons (lists.equiv.refl _) _ (l₁_ih (list.subset_of_cons_subset h)),
  simp at h, simp [h]
end

@[refl] theorem subset.refl {l : lists' α tt} : l ⊆ l :=
by rw ← lists'.of_to_list l; exact
   of_list_subset (list.subset.refl _)

theorem subset_nil {l : lists' α tt} :
  l ⊆ lists'.nil → l = lists'.nil :=
begin
  rw ← of_to_list l,
  induction to_list l; intro h, {refl},
  rcases cons_subset.1 h with ⟨⟨_, ⟨⟩, _⟩, _⟩
end

theorem mem_of_subset' {a} {l₁ l₂ : lists' α tt}
  (s : l₁ ⊆ l₂) (h : a ∈ l₁.to_list) : a ∈ l₂ :=
begin
  induction s with _ a a' l l' e m s IH, {cases h},
  simp at h, rcases h with rfl|h,
  exacts [⟨_, m, e⟩, IH h]
end

theorem subset_def {l₁ l₂ : lists' α tt} :
  l₁ ⊆ l₂ ↔ ∀ a ∈ l₁.to_list, a ∈ l₂ :=
⟨λ H a, mem_of_subset' H, λ H, begin
  rw ← of_to_list l₁,
  revert H, induction to_list l₁; intro,
  { exact subset.nil },
  { simp at H, exact cons_subset.2 ⟨H.1, ih H.2⟩ }
end⟩

end lists'

namespace lists

@[pattern] def atom (a : α) : lists α := ⟨_, lists'.atom a⟩

@[pattern] def of' (l : lists' α tt) : lists α := ⟨_, l⟩

@[simp] def to_list : lists α → list (lists α)
| ⟨b, l⟩ := l.to_list

def is_list (l : lists α) : Prop := l.1

def of_list (l : list (lists α)) : lists α := of' (lists'.of_list l)

theorem is_list_to_list (l : list (lists α)) : is_list (of_list l) :=
eq.refl _

theorem to_of_list (l : list (lists α)) : to_list (of_list l) = l :=
by simp [of_list, of']

theorem of_to_list : ∀ {l : lists α}, is_list l → of_list (to_list l) = l
| ⟨tt, l⟩ _ := by simp [of_list, of']

instance : inhabited (lists α) :=
⟨of' lists'.nil⟩

instance [decidable_eq α] : decidable_eq (lists α) :=
by unfold lists; apply_instance

instance [has_sizeof α] : has_sizeof (lists α) :=
by unfold lists; apply_instance

def induction_mut (C : lists α → Sort*) (D : lists' α tt → Sort*)
  (C0 : ∀ a, C (atom a)) (C1 : ∀ l, D l → C (of' l))
  (D0 : D lists'.nil) (D1 : ∀ a l, C a → D l → D (lists'.cons a l)) :
  pprod (∀ l, C l) (∀ l, D l) :=
begin
  suffices : ∀ {b} (l : lists' α b),
    pprod (C ⟨_, l⟩) (match b, l with
    | tt, l := D l
    | ff, l := punit
    end),
  { exact ⟨λ ⟨b, l⟩, (this _).1, λ l, (this l).2⟩ },
  intros, induction l with a b a l IH₁ IH₂,
  { exact ⟨C0 _, ⟨⟩⟩ },
  { exact ⟨C1 _ D0, D0⟩ },
  { suffices, {exact ⟨C1 _ this, this⟩},
    exact D1 ⟨_, _⟩ _ IH₁.1 IH₂.2 }
end

def mem (a : lists α) : lists α → Prop
| ⟨ff, l⟩ := false
| ⟨tt, l⟩ := a ∈ l

instance : has_mem (lists α) (lists α) := ⟨mem⟩

theorem is_list_of_mem {a : lists α} : ∀ {l : lists α}, a ∈ l → is_list l
| ⟨_, lists'.nil⟩       _ := rfl
| ⟨_, lists'.cons' _ _⟩ _ := rfl

theorem equiv.antisymm_iff {l₁ l₂ : lists' α tt} :
  of' l₁ ~ of' l₂ ↔ l₁ ⊆ l₂ ∧ l₂ ⊆ l₁ :=
begin
  refine ⟨λ h, _, λ ⟨h₁, h₂⟩, equiv.antisymm h₁ h₂⟩,
  cases h with _ _ _ h₁ h₂,
  { simp [lists'.subset.refl] }, { exact ⟨h₁, h₂⟩ }
end

attribute [refl] equiv.refl

theorem equiv_atom {a} {l : lists α} : atom a ~ l ↔ atom a = l :=
⟨λ h, by cases h; refl, λ h, h ▸ equiv.refl _⟩

theorem equiv.symm {l₁ l₂ : lists α} (h : l₁ ~ l₂) : l₂ ~ l₁ :=
by cases h with _ _ _ h₁ h₂; [refl, exact equiv.antisymm h₂ h₁]

theorem equiv.trans : ∀ {l₁ l₂ l₃ : lists α}, l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
begin
  let trans := λ (l₁ : lists α), ∀ ⦃l₂ l₃⦄, l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃,
  suffices : pprod (∀ l₁, trans l₁)
    (∀ (l : lists' α tt) (l' ∈ l.to_list), trans l'), {exact this.1},
  apply induction_mut,
  { intros a l₂ l₃ h₁ h₂,
    rwa ← equiv_atom.1 h₁ at h₂ },
  { intros l₁ IH l₂ l₃ h₁ h₂,
    cases h₁ with _ _ l₂, {exact h₂},
    cases h₂ with _ _ l₃, {exact h₁},
    cases equiv.antisymm_iff.1 h₁ with hl₁ hr₁,
    cases equiv.antisymm_iff.1 h₂ with hl₂ hr₂,
    apply equiv.antisymm_iff.2; split; apply lists'.subset_def.2,
    { intros a₁ m₁,
      rcases lists'.mem_of_subset' hl₁ m₁ with ⟨a₂, m₂, e₁₂⟩,
      rcases lists'.mem_of_subset' hl₂ m₂ with ⟨a₃, m₃, e₂₃⟩,
      exact ⟨a₃, m₃, IH _ m₁ e₁₂ e₂₃⟩ },
    { intros a₃ m₃,
      rcases lists'.mem_of_subset' hr₂ m₃ with ⟨a₂, m₂, e₃₂⟩,
      rcases lists'.mem_of_subset' hr₁ m₂ with ⟨a₁, m₁, e₂₁⟩,
      exact ⟨a₁, m₁, (IH _ m₁ e₂₁.symm e₃₂.symm).symm⟩ } },
  { rintro _ ⟨⟩ },
  { intros a l IH₁ IH₂, simpa [IH₁] using IH₂ }
end

instance : setoid (lists α) :=
⟨(~), equiv.refl, @equiv.symm _, @equiv.trans _⟩

section decidable

@[simp] def equiv.decidable_meas :
  (psum (Σ' (l₁ : lists α), lists α) $
   psum (Σ' (l₁ : lists' α tt), lists' α tt)
   Σ' (a : lists α), lists' α tt) → ℕ
| (psum.inl ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂
| (psum.inr $ psum.inl ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂
| (psum.inr $ psum.inr ⟨l₁, l₂⟩) := sizeof l₁ + sizeof l₂

open well_founded_tactics

theorem sizeof_pos {b} (l : lists' α b) : 0 < sizeof l :=
by cases l; unfold_sizeof; trivial_nat_lt

theorem lt_sizeof_cons' {b} (a : lists' α b) (l) :
  sizeof (⟨b, a⟩ : lists α) < sizeof (lists'.cons' a l) :=
by {unfold_sizeof, apply sizeof_pos}

@[instance] mutual def equiv.decidable, subset.decidable, mem.decidable [decidable_eq α]
with equiv.decidable : ∀ l₁ l₂ : lists α, decidable (l₁ ~ l₂)
| ⟨ff, l₁⟩ ⟨ff, l₂⟩ := decidable_of_iff' (l₁ = l₂) $
  by cases l₁; refine equiv_atom.trans (by simp [atom])
| ⟨ff, l₁⟩ ⟨tt, l₂⟩ := is_false $ by rintro ⟨⟩
| ⟨tt, l₁⟩ ⟨ff, l₂⟩ := is_false $ by rintro ⟨⟩
| ⟨tt, l₁⟩ ⟨tt, l₂⟩ := begin
  haveI :=
    have sizeof l₁ + sizeof l₂ <
         sizeof (⟨tt, l₁⟩ : lists α) + sizeof (⟨tt, l₂⟩ : lists α),
    by default_dec_tac,
    subset.decidable l₁ l₂,
  haveI :=
    have sizeof l₂ + sizeof l₁ <
         sizeof (⟨tt, l₁⟩ : lists α) + sizeof (⟨tt, l₂⟩ : lists α),
    by default_dec_tac,
    subset.decidable l₂ l₁,
  exact decidable_of_iff' _ equiv.antisymm_iff,
end
with subset.decidable : ∀ l₁ l₂ : lists' α tt, decidable (l₁ ⊆ l₂)
| lists'.nil l₂ := is_true subset.nil
| (@lists'.cons' _ b a l₁) l₂ := begin
  haveI :=
    have sizeof (⟨b, a⟩ : lists α) + sizeof l₂ <
         sizeof (lists'.cons' a l₁) + sizeof l₂,
    from add_lt_add_right (lt_sizeof_cons' _ _) _,
    mem.decidable ⟨b, a⟩ l₂,
  haveI :=
    have sizeof l₁ + sizeof l₂ <
         sizeof (lists'.cons' a l₁) + sizeof l₂,
    by default_dec_tac,
    subset.decidable l₁ l₂,
  exact decidable_of_iff' _ (@lists'.cons_subset _ ⟨_, _⟩ _ _)
end
with mem.decidable : ∀ (a : lists α) (l : lists' α tt), decidable (a ∈ l)
| a lists'.nil := is_false $ by rintro ⟨_, ⟨⟩, _⟩
| a (lists'.cons' b l₂) := begin
  haveI :=
    have sizeof a + sizeof (⟨_, b⟩ : lists α) <
         sizeof a + sizeof (lists'.cons' b l₂),
    from add_lt_add_left (lt_sizeof_cons' _ _) _,
    equiv.decidable a ⟨_, b⟩,
  haveI :=
    have sizeof a + sizeof l₂ <
         sizeof a + sizeof (lists'.cons' b l₂),
    by default_dec_tac,
    mem.decidable a l₂,
  refine decidable_of_iff' (a ~ ⟨_, b⟩ ∨ a ∈ l₂) _,
  rw ← lists'.mem_cons, refl
end
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf equiv.decidable_meas⟩],
  dec_tac := `[assumption] }

end decidable

end lists

namespace lists'

theorem mem_equiv_left {l : lists' α tt} :
  ∀ {a a'}, a ~ a' → (a ∈ l ↔ a' ∈ l) :=
suffices ∀ {a a'}, a ~ a' → a ∈ l → a' ∈ l,
  from λ a a' e, ⟨this e, this e.symm⟩,
λ a₁ a₂ e₁ ⟨a₃, m₃, e₂⟩, ⟨_, m₃, e₁.symm.trans e₂⟩

theorem mem_of_subset {a} {l₁ l₂ : lists' α tt}
  (s : l₁ ⊆ l₂) : a ∈ l₁ → a ∈ l₂ | ⟨a', m, e⟩ :=
(mem_equiv_left e).2 (mem_of_subset' s m)

theorem subset.trans {l₁ l₂ l₃ : lists' α tt}
  (h₁ : l₁ ⊆ l₂) (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
subset_def.2 $ λ a₁ m₁, mem_of_subset h₂ $ mem_of_subset' h₁ m₁

end lists'

def finsets (α : Type*) := quotient (@lists.setoid α)

namespace finsets

instance : has_emptyc (finsets α) := ⟨⟦lists.of' lists'.nil⟧⟩

instance : inhabited (finsets α) := ⟨∅⟩

instance [decidable_eq α] : decidable_eq (finsets α) :=
by unfold finsets; apply_instance

end finsets


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Johannes Hölzl, Mario Carneiro

-- QUESTION: can make the first argument in ∀ x ∈ a, ... implicit?
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.complete_boolean_algebra
import Mathlib.data.sigma.basic
import Mathlib.order.galois_connection
import Mathlib.order.directed
import Mathlib.PostPort

universes u v x y u_1 u_2 u_3 w

namespace Mathlib

namespace set

protected instance lattice_set {α : Type u} : complete_lattice (set α) :=
  complete_lattice.mk boolean_algebra.sup boolean_algebra.le boolean_algebra.lt sorry sorry sorry sorry sorry sorry
    boolean_algebra.inf sorry sorry sorry boolean_algebra.top sorry boolean_algebra.bot sorry
    (fun (s : set (set α)) => set_of fun (a : α) => ∃ (t : set α), ∃ (H : t ∈ s), a ∈ t)
    (fun (s : set (set α)) => set_of fun (a : α) => ∀ (t : set α), t ∈ s → a ∈ t) sorry sorry sorry sorry

/-- Image is monotone. See `set.image_image` for the statement in terms of `⊆`. -/
theorem monotone_image {α : Type u} {β : Type v} {f : α → β} : monotone (image f) :=
  fun (s t : set α) (h : s ⊆ t) => image_subset f h

theorem monotone_inter {α : Type u} {β : Type v} [preorder β] {f : β → set α} {g : β → set α} (hf : monotone f) (hg : monotone g) : monotone fun (x : β) => f x ∩ g x :=
  fun (b₁ b₂ : β) (h : b₁ ≤ b₂) => inter_subset_inter (hf h) (hg h)

theorem monotone_union {α : Type u} {β : Type v} [preorder β] {f : β → set α} {g : β → set α} (hf : monotone f) (hg : monotone g) : monotone fun (x : β) => f x ∪ g x :=
  fun (b₁ b₂ : β) (h : b₁ ≤ b₂) => union_subset_union (hf h) (hg h)

theorem monotone_set_of {α : Type u} {β : Type v} [preorder α] {p : α → β → Prop} (hp : ∀ (b : β), monotone fun (a : α) => p a b) : monotone fun (a : α) => set_of fun (b : β) => p a b :=
  fun (a a' : α) (h : a ≤ a') (b : β) => hp b h

protected theorem image_preimage {α : Type u} {β : Type v} {f : α → β} : galois_connection (image f) (preimage f) :=
  fun (a : set α) (b : set β) => image_subset_iff

/-- `kern_image f s` is the set of `y` such that `f ⁻¹ y ⊆ s` -/
def kern_image {α : Type u} {β : Type v} (f : α → β) (s : set α) : set β :=
  set_of fun (y : β) => ∀ {x : α}, f x = y → x ∈ s

protected theorem preimage_kern_image {α : Type u} {β : Type v} {f : α → β} : galois_connection (preimage f) (kern_image f) := sorry

/- union and intersection over a family of sets indexed by a type -/

/-- Indexed union of a family of sets -/
def Union {β : Type v} {ι : Sort x} (s : ι → set β) : set β :=
  supr s

/-- Indexed intersection of a family of sets -/
def Inter {β : Type v} {ι : Sort x} (s : ι → set β) : set β :=
  infi s

@[simp] theorem mem_Union {β : Type v} {ι : Sort x} {x : β} {s : ι → set β} : x ∈ Union s ↔ ∃ (i : ι), x ∈ s i := sorry

/- alternative proof: dsimp [Union, supr, Sup]; simp -/

theorem set_of_exists {β : Type v} {ι : Sort x} (p : ι → β → Prop) : (set_of fun (x : β) => ∃ (i : ι), p i x) = Union fun (i : ι) => set_of fun (x : β) => p i x :=
  ext fun (i : β) => iff.symm mem_Union

@[simp] theorem mem_Inter {β : Type v} {ι : Sort x} {x : β} {s : ι → set β} : x ∈ Inter s ↔ ∀ (i : ι), x ∈ s i := sorry

theorem set_of_forall {β : Type v} {ι : Sort x} (p : ι → β → Prop) : (set_of fun (x : β) => ∀ (i : ι), p i x) = Inter fun (i : ι) => set_of fun (x : β) => p i x :=
  ext fun (i : β) => iff.symm mem_Inter

-- TODO: should be simpler when sets' order is based on lattices

theorem Union_subset {β : Type v} {ι : Sort x} {s : ι → set β} {t : set β} (h : ∀ (i : ι), s i ⊆ t) : (Union fun (i : ι) => s i) ⊆ t :=
  supr_le h

theorem Union_subset_iff {β : Type v} {ι : Sort x} {s : ι → set β} {t : set β} : (Union fun (i : ι) => s i) ⊆ t ↔ ∀ (i : ι), s i ⊆ t :=
  { mp := fun (h : (Union fun (i : ι) => s i) ⊆ t) (i : ι) => subset.trans (le_supr s i) h, mpr := Union_subset }

theorem mem_Inter_of_mem {β : Type v} {ι : Sort x} {x : β} {s : ι → set β} : (∀ (i : ι), x ∈ s i) → x ∈ Inter fun (i : ι) => s i :=
  iff.mpr mem_Inter

-- TODO: should be simpler when sets' order is based on lattices

theorem subset_Inter {β : Type v} {ι : Sort x} {t : set β} {s : ι → set β} (h : ∀ (i : ι), t ⊆ s i) : t ⊆ Inter fun (i : ι) => s i :=
  le_infi h

theorem subset_Inter_iff {β : Type v} {ι : Sort x} {t : set β} {s : ι → set β} : (t ⊆ Inter fun (i : ι) => s i) ↔ ∀ (i : ι), t ⊆ s i :=
  le_infi_iff

theorem subset_Union {β : Type v} {ι : Sort x} (s : ι → set β) (i : ι) : s i ⊆ Union fun (i : ι) => s i :=
  le_supr

-- This rather trivial consequence is convenient with `apply`,

-- and has `i` explicit for this use case.

theorem subset_subset_Union {β : Type v} {ι : Sort x} {A : set β} {s : ι → set β} (i : ι) (h : A ⊆ s i) : A ⊆ Union fun (i : ι) => s i :=
  subset.trans h (subset_Union s i)

theorem Inter_subset {β : Type v} {ι : Sort x} (s : ι → set β) (i : ι) : (Inter fun (i : ι) => s i) ⊆ s i :=
  infi_le

theorem Inter_subset_of_subset {α : Type u} {ι : Sort x} {s : ι → set α} {t : set α} (i : ι) (h : s i ⊆ t) : (Inter fun (i : ι) => s i) ⊆ t :=
  subset.trans (Inter_subset s i) h

theorem Inter_subset_Inter {α : Type u} {ι : Sort x} {s : ι → set α} {t : ι → set α} (h : ∀ (i : ι), s i ⊆ t i) : (Inter fun (i : ι) => s i) ⊆ Inter fun (i : ι) => t i :=
  subset_Inter fun (i : ι) => Inter_subset_of_subset i (h i)

theorem Inter_subset_Inter2 {α : Type u} {ι : Sort x} {ι' : Sort y} {s : ι → set α} {t : ι' → set α} (h : ∀ (j : ι'), ∃ (i : ι), s i ⊆ t j) : (Inter fun (i : ι) => s i) ⊆ Inter fun (j : ι') => t j := sorry

theorem Inter_set_of {α : Type u} {ι : Sort x} (P : ι → α → Prop) : (Inter fun (i : ι) => set_of fun (x : α) => P i x) = set_of fun (x : α) => ∀ (i : ι), P i x := sorry

theorem Union_const {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) : (Union fun (i : ι) => s) = s := sorry

theorem Inter_const {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) : (Inter fun (i : ι) => s) = s := sorry

@[simp] theorem compl_Union {β : Type v} {ι : Sort x} (s : ι → set β) : (Union fun (i : ι) => s i)ᶜ = Inter fun (i : ι) => s iᶜ := sorry

-- classical -- complete_boolean_algebra

theorem compl_Inter {β : Type v} {ι : Sort x} (s : ι → set β) : (Inter fun (i : ι) => s i)ᶜ = Union fun (i : ι) => s iᶜ := sorry

-- classical -- complete_boolean_algebra

theorem Union_eq_comp_Inter_comp {β : Type v} {ι : Sort x} (s : ι → set β) : (Union fun (i : ι) => s i) = ((Inter fun (i : ι) => s iᶜ)ᶜ) := sorry

-- classical -- complete_boolean_algebra

theorem Inter_eq_comp_Union_comp {β : Type v} {ι : Sort x} (s : ι → set β) : (Inter fun (i : ι) => s i) = ((Union fun (i : ι) => s iᶜ)ᶜ) := sorry

theorem inter_Union {β : Type v} {ι : Sort x} (s : set β) (t : ι → set β) : (s ∩ Union fun (i : ι) => t i) = Union fun (i : ι) => s ∩ t i := sorry

theorem Union_inter {β : Type v} {ι : Sort x} (s : set β) (t : ι → set β) : (Union fun (i : ι) => t i) ∩ s = Union fun (i : ι) => t i ∩ s := sorry

theorem Union_union_distrib {β : Type v} {ι : Sort x} (s : ι → set β) (t : ι → set β) : (Union fun (i : ι) => s i ∪ t i) = (Union fun (i : ι) => s i) ∪ Union fun (i : ι) => t i := sorry

theorem Inter_inter_distrib {β : Type v} {ι : Sort x} (s : ι → set β) (t : ι → set β) : (Inter fun (i : ι) => s i ∩ t i) = (Inter fun (i : ι) => s i) ∩ Inter fun (i : ι) => t i := sorry

theorem union_Union {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) (t : ι → set β) : (s ∪ Union fun (i : ι) => t i) = Union fun (i : ι) => s ∪ t i := sorry

theorem Union_union {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) (t : ι → set β) : (Union fun (i : ι) => t i) ∪ s = Union fun (i : ι) => t i ∪ s := sorry

theorem inter_Inter {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) (t : ι → set β) : (s ∩ Inter fun (i : ι) => t i) = Inter fun (i : ι) => s ∩ t i := sorry

theorem Inter_inter {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) (t : ι → set β) : (Inter fun (i : ι) => t i) ∩ s = Inter fun (i : ι) => t i ∩ s := sorry

-- classical

theorem union_Inter {β : Type v} {ι : Sort x} (s : set β) (t : ι → set β) : (s ∪ Inter fun (i : ι) => t i) = Inter fun (i : ι) => s ∪ t i := sorry

theorem Union_diff {β : Type v} {ι : Sort x} (s : set β) (t : ι → set β) : (Union fun (i : ι) => t i) \ s = Union fun (i : ι) => t i \ s :=
  Union_inter (fun (a : β) => a ∈ s → False) fun (i : ι) => t i

theorem diff_Union {β : Type v} {ι : Sort x} [Nonempty ι] (s : set β) (t : ι → set β) : (s \ Union fun (i : ι) => t i) = Inter fun (i : ι) => s \ t i := sorry

theorem diff_Inter {β : Type v} {ι : Sort x} (s : set β) (t : ι → set β) : (s \ Inter fun (i : ι) => t i) = Union fun (i : ι) => s \ t i := sorry

theorem directed_on_Union {α : Type u} {r : α → α → Prop} {ι : Sort v} {f : ι → set α} (hd : directed has_subset.subset f) (h : ∀ (x : ι), directed_on r (f x)) : directed_on r (Union fun (x : ι) => f x) := sorry

theorem Union_inter_subset {ι : Sort u_1} {α : Type u_2} {s : ι → set α} {t : ι → set α} : (Union fun (i : ι) => s i ∩ t i) ⊆ (Union fun (i : ι) => s i) ∩ Union fun (i : ι) => t i := sorry

theorem Union_inter_of_monotone {ι : Type u_1} {α : Type u_2} [semilattice_sup ι] {s : ι → set α} {t : ι → set α} (hs : monotone s) (ht : monotone t) : (Union fun (i : ι) => s i ∩ t i) = (Union fun (i : ι) => s i) ∩ Union fun (i : ι) => t i := sorry

/-- An equality version of this lemma is `Union_Inter_of_monotone` in `data.set.finite`. -/
theorem Union_Inter_subset {ι : Sort u_1} {ι' : Sort u_2} {α : Type u_3} {s : ι → ι' → set α} : (Union fun (j : ι') => Inter fun (i : ι) => s i j) ⊆ Inter fun (i : ι) => Union fun (j : ι') => s i j := sorry

/- bounded unions and intersections -/

theorem mem_bUnion_iff {α : Type u} {β : Type v} {s : set α} {t : α → set β} {y : β} : (y ∈ Union fun (x : α) => Union fun (H : x ∈ s) => t x) ↔ ∃ (x : α), ∃ (H : x ∈ s), y ∈ t x := sorry

theorem mem_bInter_iff {α : Type u} {β : Type v} {s : set α} {t : α → set β} {y : β} : (y ∈ Inter fun (x : α) => Inter fun (H : x ∈ s) => t x) ↔ ∀ (x : α), x ∈ s → y ∈ t x := sorry

theorem mem_bUnion {α : Type u} {β : Type v} {s : set α} {t : α → set β} {x : α} {y : β} (xs : x ∈ s) (ytx : y ∈ t x) : y ∈ Union fun (x : α) => Union fun (H : x ∈ s) => t x := sorry

theorem mem_bInter {α : Type u} {β : Type v} {s : set α} {t : α → set β} {y : β} (h : ∀ (x : α), x ∈ s → y ∈ t x) : y ∈ Inter fun (x : α) => Inter fun (H : x ∈ s) => t x :=
  eq.mpr (id (Eq.trans (propext mem_Inter) (forall_congr_eq fun (i : α) => propext mem_Inter))) h

theorem bUnion_subset {α : Type u} {β : Type v} {s : set α} {t : set β} {u : α → set β} (h : ∀ (x : α), x ∈ s → u x ⊆ t) : (Union fun (x : α) => Union fun (H : x ∈ s) => u x) ⊆ t :=
  (fun (this : (supr fun (x : α) => supr fun (H : x ∈ s) => u x) ≤ t) => this) (supr_le fun (x : α) => supr_le (h x))

theorem subset_bInter {α : Type u} {β : Type v} {s : set α} {t : set β} {u : α → set β} (h : ∀ (x : α), x ∈ s → t ⊆ u x) : t ⊆ Inter fun (x : α) => Inter fun (H : x ∈ s) => u x :=
  subset_Inter fun (x : α) => subset_Inter (h x)

theorem subset_bUnion_of_mem {α : Type u} {β : Type v} {s : set α} {u : α → set β} {x : α} (xs : x ∈ s) : u x ⊆ Union fun (x : α) => Union fun (H : x ∈ s) => u x :=
  (fun (this : u x ≤ supr fun (x : α) => supr fun (H : x ∈ s) => u x) => this)
    (le_supr_of_le x (le_supr (fun (xs : x ∈ s) => u x) xs))

theorem bInter_subset_of_mem {α : Type u} {β : Type v} {s : set α} {t : α → set β} {x : α} (xs : x ∈ s) : (Inter fun (x : α) => Inter fun (H : x ∈ s) => t x) ⊆ t x :=
  (fun (this : (infi fun (x : α) => infi fun (H : x ∈ s) => t x) ≤ t x) => this)
    (infi_le_of_le x (infi_le (fun (H : x ∈ s) => t x) xs))

theorem bUnion_subset_bUnion_left {α : Type u} {β : Type v} {s : set α} {s' : set α} {t : α → set β} (h : s ⊆ s') : (Union fun (x : α) => Union fun (H : x ∈ s) => t x) ⊆ Union fun (x : α) => Union fun (H : x ∈ s') => t x :=
  bUnion_subset fun (x : α) (xs : x ∈ s) => subset_bUnion_of_mem (h xs)

theorem bInter_subset_bInter_left {α : Type u} {β : Type v} {s : set α} {s' : set α} {t : α → set β} (h : s' ⊆ s) : (Inter fun (x : α) => Inter fun (H : x ∈ s) => t x) ⊆ Inter fun (x : α) => Inter fun (H : x ∈ s') => t x :=
  subset_bInter fun (x : α) (xs : x ∈ s') => bInter_subset_of_mem (h xs)

theorem bUnion_subset_bUnion_right {α : Type u} {β : Type v} {s : set α} {t1 : α → set β} {t2 : α → set β} (h : ∀ (x : α), x ∈ s → t1 x ⊆ t2 x) : (Union fun (x : α) => Union fun (H : x ∈ s) => t1 x) ⊆ Union fun (x : α) => Union fun (H : x ∈ s) => t2 x :=
  bUnion_subset fun (x : α) (xs : x ∈ s) => subset.trans (h x xs) (subset_bUnion_of_mem xs)

theorem bInter_subset_bInter_right {α : Type u} {β : Type v} {s : set α} {t1 : α → set β} {t2 : α → set β} (h : ∀ (x : α), x ∈ s → t1 x ⊆ t2 x) : (Inter fun (x : α) => Inter fun (H : x ∈ s) => t1 x) ⊆ Inter fun (x : α) => Inter fun (H : x ∈ s) => t2 x :=
  subset_bInter fun (x : α) (xs : x ∈ s) => subset.trans (bInter_subset_of_mem xs) (h x xs)

theorem bUnion_subset_bUnion {α : Type u} {β : Type v} {γ : Type u_1} {s : set α} {t : α → set β} {s' : set γ} {t' : γ → set β} (h : ∀ (x : α) (H : x ∈ s), ∃ (y : γ), ∃ (H : y ∈ s'), t x ⊆ t' y) : (Union fun (x : α) => Union fun (H : x ∈ s) => t x) ⊆ Union fun (y : γ) => Union fun (H : y ∈ s') => t' y := sorry

theorem bInter_mono' {α : Type u} {β : Type v} {s : set α} {s' : set α} {t : α → set β} {t' : α → set β} (hs : s ⊆ s') (h : ∀ (x : α), x ∈ s → t x ⊆ t' x) : (Inter fun (x : α) => Inter fun (H : x ∈ s') => t x) ⊆ Inter fun (x : α) => Inter fun (H : x ∈ s) => t' x := sorry

theorem bInter_mono {α : Type u} {β : Type v} {s : set α} {t : α → set β} {t' : α → set β} (h : ∀ (x : α), x ∈ s → t x ⊆ t' x) : (Inter fun (x : α) => Inter fun (H : x ∈ s) => t x) ⊆ Inter fun (x : α) => Inter fun (H : x ∈ s) => t' x :=
  bInter_mono' (subset.refl s) h

theorem bUnion_mono {α : Type u} {β : Type v} {s : set α} {t : α → set β} {t' : α → set β} (h : ∀ (x : α), x ∈ s → t x ⊆ t' x) : (Union fun (x : α) => Union fun (H : x ∈ s) => t x) ⊆ Union fun (x : α) => Union fun (H : x ∈ s) => t' x :=
  bUnion_subset_bUnion fun (x : α) (x_in : x ∈ s) => Exists.intro x (Exists.intro x_in (h x x_in))

theorem bUnion_eq_Union {α : Type u} {β : Type v} (s : set α) (t : (x : α) → x ∈ s → set β) : (Union fun (x : α) => Union fun (H : x ∈ s) => t x H) = Union fun (x : ↥s) => t (↑x) (subtype.property x) :=
  supr_subtype'

theorem bInter_eq_Inter {α : Type u} {β : Type v} (s : set α) (t : (x : α) → x ∈ s → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ s) => t x H) = Inter fun (x : ↥s) => t (↑x) (subtype.property x) :=
  infi_subtype'

theorem bInter_empty {α : Type u} {β : Type v} (u : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ ∅) => u x) = univ :=
  (fun (this : (infi fun (x : α) => infi fun (H : x ∈ ∅) => u x) = ⊤) => this) infi_emptyset

theorem bInter_univ {α : Type u} {β : Type v} (u : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ univ) => u x) = Inter fun (x : α) => u x :=
  infi_univ

-- TODO(Jeremy): here is an artifact of the the encoding of bounded intersection:

-- without dsimp, the next theorem fails to type check, because there is a lambda

-- in a type that needs to be contracted. Using simp [eq_of_mem_singleton xa] also works.

@[simp] theorem bInter_singleton {α : Type u} {β : Type v} (a : α) (s : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ singleton a) => s x) = s a := sorry

theorem bInter_union {α : Type u} {β : Type v} (s : set α) (t : set α) (u : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ s ∪ t) => u x) =
  (Inter fun (x : α) => Inter fun (H : x ∈ s) => u x) ∩ Inter fun (x : α) => Inter fun (H : x ∈ t) => u x := sorry

-- TODO(Jeremy): simp [insert_eq, bInter_union] doesn't work

@[simp] theorem bInter_insert {α : Type u} {β : Type v} (a : α) (s : set α) (t : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ insert a s) => t x) = t a ∩ Inter fun (x : α) => Inter fun (H : x ∈ s) => t x := sorry

-- TODO(Jeremy): another example of where an annotation is needed

theorem bInter_pair {α : Type u} {β : Type v} (a : α) (b : α) (s : α → set β) : (Inter fun (x : α) => Inter fun (H : x ∈ insert a (singleton b)) => s x) = s a ∩ s b := sorry

theorem bUnion_empty {α : Type u} {β : Type v} (s : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ ∅) => s x) = ∅ :=
  supr_emptyset

theorem bUnion_univ {α : Type u} {β : Type v} (s : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ univ) => s x) = Union fun (x : α) => s x :=
  supr_univ

@[simp] theorem bUnion_singleton {α : Type u} {β : Type v} (a : α) (s : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ singleton a) => s x) = s a :=
  supr_singleton

@[simp] theorem bUnion_of_singleton {α : Type u} (s : set α) : (Union fun (x : α) => Union fun (H : x ∈ s) => singleton x) = s := sorry

theorem bUnion_union {α : Type u} {β : Type v} (s : set α) (t : set α) (u : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ s ∪ t) => u x) =
  (Union fun (x : α) => Union fun (H : x ∈ s) => u x) ∪ Union fun (x : α) => Union fun (H : x ∈ t) => u x :=
  supr_union

@[simp] theorem Union_subtype {α : Type u_1} {β : Type u_2} (s : set α) (f : α → set β) : (Union fun (i : ↥s) => f ↑i) = Union fun (i : α) => Union fun (H : i ∈ s) => f i :=
  Eq.symm (bUnion_eq_Union s fun (x : α) (_x : x ∈ s) => f x)

-- TODO(Jeremy): once again, simp doesn't do it alone.

@[simp] theorem bUnion_insert {α : Type u} {β : Type v} (a : α) (s : set α) (t : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ insert a s) => t x) = t a ∪ Union fun (x : α) => Union fun (H : x ∈ s) => t x := sorry

theorem bUnion_pair {α : Type u} {β : Type v} (a : α) (b : α) (s : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ insert a (singleton b)) => s x) = s a ∪ s b := sorry

@[simp] theorem compl_bUnion {α : Type u} {β : Type v} (s : set α) (t : α → set β) : (Union fun (i : α) => Union fun (H : i ∈ s) => t i)ᶜ = Inter fun (i : α) => Inter fun (H : i ∈ s) => t iᶜ := sorry

-- classical -- complete_boolean_algebra

theorem compl_bInter {α : Type u} {β : Type v} (s : set α) (t : α → set β) : (Inter fun (i : α) => Inter fun (H : i ∈ s) => t i)ᶜ = Union fun (i : α) => Union fun (H : i ∈ s) => t iᶜ := sorry

theorem inter_bUnion {α : Type u} {β : Type v} (s : set α) (t : α → set β) (u : set β) : (u ∩ Union fun (i : α) => Union fun (H : i ∈ s) => t i) = Union fun (i : α) => Union fun (H : i ∈ s) => u ∩ t i := sorry

theorem bUnion_inter {α : Type u} {β : Type v} (s : set α) (t : α → set β) (u : set β) : (Union fun (i : α) => Union fun (H : i ∈ s) => t i) ∩ u = Union fun (i : α) => Union fun (H : i ∈ s) => t i ∩ u := sorry

/-- Intersection of a set of sets. -/
def sInter {α : Type u} (S : set (set α)) : set α :=
  Inf S

prefix:110 "⋂₀" => Mathlib.set.sInter

theorem mem_sUnion_of_mem {α : Type u} {x : α} {t : set α} {S : set (set α)} (hx : x ∈ t) (ht : t ∈ S) : x ∈ ⋃₀S :=
  Exists.intro t (Exists.intro ht hx)

theorem mem_sUnion {α : Type u} {x : α} {S : set (set α)} : x ∈ ⋃₀S ↔ ∃ (t : set α), ∃ (H : t ∈ S), x ∈ t :=
  iff.rfl

-- is this theorem really necessary?

theorem not_mem_of_not_mem_sUnion {α : Type u} {x : α} {t : set α} {S : set (set α)} (hx : ¬x ∈ ⋃₀S) (ht : t ∈ S) : ¬x ∈ t :=
  fun (h : x ∈ t) => hx (Exists.intro t (Exists.intro ht h))

@[simp] theorem mem_sInter {α : Type u} {x : α} {S : set (set α)} : x ∈ ⋂₀S ↔ ∀ (t : set α), t ∈ S → x ∈ t :=
  iff.rfl

theorem sInter_subset_of_mem {α : Type u} {S : set (set α)} {t : set α} (tS : t ∈ S) : ⋂₀S ⊆ t :=
  Inf_le tS

theorem subset_sUnion_of_mem {α : Type u} {S : set (set α)} {t : set α} (tS : t ∈ S) : t ⊆ ⋃₀S :=
  le_Sup tS

theorem subset_sUnion_of_subset {α : Type u} {s : set α} (t : set (set α)) (u : set α) (h₁ : s ⊆ u) (h₂ : u ∈ t) : s ⊆ ⋃₀t :=
  subset.trans h₁ (subset_sUnion_of_mem h₂)

theorem sUnion_subset {α : Type u} {S : set (set α)} {t : set α} (h : ∀ (t' : set α), t' ∈ S → t' ⊆ t) : ⋃₀S ⊆ t :=
  Sup_le h

theorem sUnion_subset_iff {α : Type u} {s : set (set α)} {t : set α} : ⋃₀s ⊆ t ↔ ∀ (t' : set α), t' ∈ s → t' ⊆ t :=
  { mp := fun (h : ⋃₀s ⊆ t) (t' : set α) (ht' : t' ∈ s) => subset.trans (subset_sUnion_of_mem ht') h,
    mpr := sUnion_subset }

theorem subset_sInter {α : Type u} {S : set (set α)} {t : set α} (h : ∀ (t' : set α), t' ∈ S → t ⊆ t') : t ⊆ ⋂₀S :=
  le_Inf h

theorem sUnion_subset_sUnion {α : Type u} {S : set (set α)} {T : set (set α)} (h : S ⊆ T) : ⋃₀S ⊆ ⋃₀T :=
  sUnion_subset fun (s : set α) (hs : s ∈ S) => subset_sUnion_of_mem (h hs)

theorem sInter_subset_sInter {α : Type u} {S : set (set α)} {T : set (set α)} (h : S ⊆ T) : ⋂₀T ⊆ ⋂₀S :=
  subset_sInter fun (s : set α) (hs : s ∈ S) => sInter_subset_of_mem (h hs)

@[simp] theorem sUnion_empty {α : Type u} : ⋃₀∅ = ∅ :=
  Sup_empty

@[simp] theorem sInter_empty {α : Type u} : ⋂₀∅ = univ :=
  Inf_empty

@[simp] theorem sUnion_singleton {α : Type u} (s : set α) : ⋃₀singleton s = s :=
  Sup_singleton

@[simp] theorem sInter_singleton {α : Type u} (s : set α) : ⋂₀singleton s = s :=
  Inf_singleton

@[simp] theorem sUnion_eq_empty {α : Type u} {S : set (set α)} : ⋃₀S = ∅ ↔ ∀ (s : set α), s ∈ S → s = ∅ :=
  Sup_eq_bot

@[simp] theorem sInter_eq_univ {α : Type u} {S : set (set α)} : ⋂₀S = univ ↔ ∀ (s : set α), s ∈ S → s = univ :=
  Inf_eq_top

@[simp] theorem nonempty_sUnion {α : Type u} {S : set (set α)} : set.nonempty (⋃₀S) ↔ ∃ (s : set α), ∃ (H : s ∈ S), set.nonempty s := sorry

theorem nonempty.of_sUnion {α : Type u} {s : set (set α)} (h : set.nonempty (⋃₀s)) : set.nonempty s := sorry

theorem nonempty.of_sUnion_eq_univ {α : Type u} [Nonempty α] {s : set (set α)} (h : ⋃₀s = univ) : set.nonempty s :=
  nonempty.of_sUnion (Eq.symm h ▸ univ_nonempty)

theorem sUnion_union {α : Type u} (S : set (set α)) (T : set (set α)) : ⋃₀(S ∪ T) = ⋃₀S ∪ ⋃₀T :=
  Sup_union

theorem sInter_union {α : Type u} (S : set (set α)) (T : set (set α)) : ⋂₀(S ∪ T) = ⋂₀S ∩ ⋂₀T :=
  Inf_union

theorem sInter_Union {α : Type u} {ι : Sort x} (s : ι → set (set α)) : (⋂₀Union fun (i : ι) => s i) = Inter fun (i : ι) => ⋂₀s i := sorry

@[simp] theorem sUnion_insert {α : Type u} (s : set α) (T : set (set α)) : ⋃₀insert s T = s ∪ ⋃₀T :=
  Sup_insert

@[simp] theorem sInter_insert {α : Type u} (s : set α) (T : set (set α)) : ⋂₀insert s T = s ∩ ⋂₀T :=
  Inf_insert

theorem sUnion_pair {α : Type u} (s : set α) (t : set α) : ⋃₀insert s (singleton t) = s ∪ t :=
  Sup_pair

theorem sInter_pair {α : Type u} (s : set α) (t : set α) : ⋂₀insert s (singleton t) = s ∩ t :=
  Inf_pair

@[simp] theorem sUnion_image {α : Type u} {β : Type v} (f : α → set β) (s : set α) : ⋃₀(f '' s) = Union fun (x : α) => Union fun (H : x ∈ s) => f x :=
  Sup_image

@[simp] theorem sInter_image {α : Type u} {β : Type v} (f : α → set β) (s : set α) : ⋂₀(f '' s) = Inter fun (x : α) => Inter fun (H : x ∈ s) => f x :=
  Inf_image

@[simp] theorem sUnion_range {β : Type v} {ι : Sort x} (f : ι → set β) : ⋃₀range f = Union fun (x : ι) => f x :=
  rfl

@[simp] theorem sInter_range {β : Type v} {ι : Sort x} (f : ι → set β) : ⋂₀range f = Inter fun (x : ι) => f x :=
  rfl

theorem Union_eq_univ_iff {α : Type u} {ι : Sort x} {f : ι → set α} : (Union fun (i : ι) => f i) = univ ↔ ∀ (x : α), ∃ (i : ι), x ∈ f i := sorry

theorem bUnion_eq_univ_iff {α : Type u} {β : Type v} {f : α → set β} {s : set α} : (Union fun (x : α) => Union fun (H : x ∈ s) => f x) = univ ↔ ∀ (y : β), ∃ (x : α), ∃ (H : x ∈ s), y ∈ f x := sorry

theorem sUnion_eq_univ_iff {α : Type u} {c : set (set α)} : ⋃₀c = univ ↔ ∀ (a : α), ∃ (b : set α), ∃ (H : b ∈ c), a ∈ b := sorry

theorem compl_sUnion {α : Type u} (S : set (set α)) : ⋃₀Sᶜ = ⋂₀(compl '' S) := sorry

-- classical

theorem sUnion_eq_compl_sInter_compl {α : Type u} (S : set (set α)) : ⋃₀S = (⋂₀(compl '' S)ᶜ) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (⋃₀S = (⋂₀(compl '' S)ᶜ))) (Eq.symm (compl_compl (⋃₀S)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⋃₀Sᶜᶜ = (⋂₀(compl '' S)ᶜ))) (compl_sUnion S))) (Eq.refl (⋂₀(compl '' S)ᶜ)))

-- classical

theorem compl_sInter {α : Type u} (S : set (set α)) : ⋂₀Sᶜ = ⋃₀(compl '' S) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (⋂₀Sᶜ = ⋃₀(compl '' S))) (sUnion_eq_compl_sInter_compl (compl '' S))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⋂₀Sᶜ = (⋂₀(compl '' (compl '' S))ᶜ))) (compl_compl_image S))) (Eq.refl (⋂₀Sᶜ)))

-- classical

theorem sInter_eq_comp_sUnion_compl {α : Type u} (S : set (set α)) : ⋂₀S = (⋃₀(compl '' S)ᶜ) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (⋂₀S = (⋃₀(compl '' S)ᶜ))) (Eq.symm (compl_compl (⋂₀S)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⋂₀Sᶜᶜ = (⋃₀(compl '' S)ᶜ))) (compl_sInter S))) (Eq.refl (⋃₀(compl '' S)ᶜ)))

theorem inter_empty_of_inter_sUnion_empty {α : Type u} {s : set α} {t : set α} {S : set (set α)} (hs : t ∈ S) (h : s ∩ ⋃₀S = ∅) : s ∩ t = ∅ :=
  eq_empty_of_subset_empty
    (eq.mpr (id (Eq._oldrec (Eq.refl (s ∩ t ⊆ ∅)) (Eq.symm h))) (inter_subset_inter_right s (subset_sUnion_of_mem hs)))

theorem range_sigma_eq_Union_range {α : Type u} {β : Type v} {γ : α → Type u_1} (f : sigma γ → β) : range f = Union fun (a : α) => range fun (b : γ a) => f (sigma.mk a b) := sorry

theorem Union_eq_range_sigma {α : Type u} {β : Type v} (s : α → set β) : (Union fun (i : α) => s i) = range fun (a : sigma fun (i : α) => ↥(s i)) => ↑(sigma.snd a) := sorry

theorem Union_image_preimage_sigma_mk_eq_self {ι : Type u_1} {σ : ι → Type u_2} (s : set (sigma σ)) : (Union fun (i : ι) => sigma.mk i '' (sigma.mk i ⁻¹' s)) = s := sorry

theorem sUnion_mono {α : Type u} {s : set (set α)} {t : set (set α)} (h : s ⊆ t) : ⋃₀s ⊆ ⋃₀t :=
  sUnion_subset fun (t' : set α) (ht' : t' ∈ s) => subset_sUnion_of_mem (h ht')

theorem Union_subset_Union {α : Type u} {ι : Sort x} {s : ι → set α} {t : ι → set α} (h : ∀ (i : ι), s i ⊆ t i) : (Union fun (i : ι) => s i) ⊆ Union fun (i : ι) => t i :=
  supr_le_supr h

theorem Union_subset_Union2 {α : Type u} {ι : Sort x} {ι₂ : Sort u_1} {s : ι → set α} {t : ι₂ → set α} (h : ∀ (i : ι), ∃ (j : ι₂), s i ⊆ t j) : (Union fun (i : ι) => s i) ⊆ Union fun (i : ι₂) => t i :=
  supr_le_supr2 h

theorem Union_subset_Union_const {α : Type u} {ι : Sort x} {ι₂ : Sort x} {s : set α} (h : ι → ι₂) : (Union fun (i : ι) => s) ⊆ Union fun (j : ι₂) => s :=
  supr_le_supr_const h

@[simp] theorem Union_of_singleton (α : Type u) : (Union fun (x : α) => singleton x) = univ := sorry

@[simp] theorem Union_of_singleton_coe {α : Type u} (s : set α) : (Union fun (i : ↥s) => singleton ↑i) = s := sorry

theorem bUnion_subset_Union {α : Type u} {β : Type v} (s : set α) (t : α → set β) : (Union fun (x : α) => Union fun (H : x ∈ s) => t x) ⊆ Union fun (x : α) => t x :=
  Union_subset_Union fun (i : α) => Union_subset fun (h : i ∈ s) => subset.refl (t i)

theorem sUnion_eq_bUnion {α : Type u} {s : set (set α)} : ⋃₀s = Union fun (i : set α) => Union fun (h : i ∈ s) => i := sorry

theorem sInter_eq_bInter {α : Type u} {s : set (set α)} : ⋂₀s = Inter fun (i : set α) => Inter fun (h : i ∈ s) => i := sorry

theorem sUnion_eq_Union {α : Type u} {s : set (set α)} : ⋃₀s = Union fun (i : ↥s) => ↑i := sorry

theorem sInter_eq_Inter {α : Type u} {s : set (set α)} : ⋂₀s = Inter fun (i : ↥s) => ↑i := sorry

theorem union_eq_Union {α : Type u} {s₁ : set α} {s₂ : set α} : s₁ ∪ s₂ = Union fun (b : Bool) => cond b s₁ s₂ := sorry

theorem inter_eq_Inter {α : Type u} {s₁ : set α} {s₂ : set α} : s₁ ∩ s₂ = Inter fun (b : Bool) => cond b s₁ s₂ := sorry

protected instance complete_boolean_algebra {α : Type u} : complete_boolean_algebra (set α) :=
  complete_boolean_algebra.mk boolean_algebra.sup boolean_algebra.le boolean_algebra.lt sorry sorry sorry sorry sorry
    sorry boolean_algebra.inf sorry sorry sorry sorry boolean_algebra.top sorry boolean_algebra.bot sorry compl
    has_sdiff.sdiff sorry sorry sorry complete_lattice.Sup complete_lattice.Inf sorry sorry sorry sorry sorry sorry

theorem sInter_union_sInter {α : Type u} {S : set (set α)} {T : set (set α)} : ⋂₀S ∪ ⋂₀T = Inter fun (p : set α × set α) => Inter fun (H : p ∈ set.prod S T) => prod.fst p ∪ prod.snd p :=
  Inf_sup_Inf

theorem sUnion_inter_sUnion {α : Type u} {s : set (set α)} {t : set (set α)} : ⋃₀s ∩ ⋃₀t = Union fun (p : set α × set α) => Union fun (H : p ∈ set.prod s t) => prod.fst p ∩ prod.snd p :=
  Sup_inf_Sup

/-- If `S` is a set of sets, and each `s ∈ S` can be represented as an intersection
of sets `T s hs`, then `⋂₀ S` is the intersection of the union of all `T s hs`. -/
theorem sInter_bUnion {α : Type u} {S : set (set α)} {T : (s : set α) → s ∈ S → set (set α)} (hT : ∀ (s : set α) (H : s ∈ S), s = ⋂₀T s H) : (⋂₀Union fun (s : set α) => Union fun (H : s ∈ S) => T s H) = ⋂₀S := sorry

/-- If `S` is a set of sets, and each `s ∈ S` can be represented as an union
of sets `T s hs`, then `⋃₀ S` is the union of the union of all `T s hs`. -/
theorem sUnion_bUnion {α : Type u} {S : set (set α)} {T : (s : set α) → s ∈ S → set (set α)} (hT : ∀ (s : set α) (H : s ∈ S), s = ⋃₀T s H) : (⋃₀Union fun (s : set α) => Union fun (H : s ∈ S) => T s H) = ⋃₀S := sorry

theorem Union_range_eq_sUnion {α : Type u_1} {β : Type u_2} (C : set (set α)) {f : (s : ↥C) → β → ↥s} (hf : ∀ (s : ↥C), function.surjective (f s)) : (Union fun (y : β) => range fun (s : ↥C) => subtype.val (f s y)) = ⋃₀C := sorry

theorem Union_range_eq_Union {ι : Type u_1} {α : Type u_2} {β : Type u_3} (C : ι → set α) {f : (x : ι) → β → ↥(C x)} (hf : ∀ (x : ι), function.surjective (f x)) : (Union fun (y : β) => range fun (x : ι) => subtype.val (f x y)) = Union fun (x : ι) => C x := sorry

theorem union_distrib_Inter_right {α : Type u} {ι : Type u_1} (s : ι → set α) (t : set α) : (Inter fun (i : ι) => s i) ∪ t = Inter fun (i : ι) => s i ∪ t := sorry

theorem union_distrib_Inter_left {α : Type u} {ι : Type u_1} (s : ι → set α) (t : set α) : (t ∪ Inter fun (i : ι) => s i) = Inter fun (i : ι) => t ∪ s i := sorry

/-!
### `maps_to`
-/

theorem maps_to_sUnion {α : Type u} {β : Type v} {S : set (set α)} {t : set β} {f : α → β} (H : ∀ (s : set α), s ∈ S → maps_to f s t) : maps_to f (⋃₀S) t := sorry

theorem maps_to_Union {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} {t : set β} {f : α → β} (H : ∀ (i : ι), maps_to f (s i) t) : maps_to f (Union fun (i : ι) => s i) t :=
  maps_to_sUnion (iff.mpr forall_range_iff H)

theorem maps_to_bUnion {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : (i : ι) → p i → set α} {t : set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), maps_to f (s i hi) t) : maps_to f (Union fun (i : ι) => Union fun (hi : p i) => s i hi) t :=
  maps_to_Union fun (i : ι) => maps_to_Union (H i)

theorem maps_to_Union_Union {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), maps_to f (s i) (t i)) : maps_to f (Union fun (i : ι) => s i) (Union fun (i : ι) => t i) :=
  maps_to_Union fun (i : ι) => maps_to.mono (subset.refl (s i)) (subset_Union t i) (H i)

theorem maps_to_bUnion_bUnion {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : (i : ι) → p i → set α} {t : (i : ι) → p i → set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), maps_to f (s i hi) (t i hi)) : maps_to f (Union fun (i : ι) => Union fun (hi : p i) => s i hi) (Union fun (i : ι) => Union fun (hi : p i) => t i hi) :=
  maps_to_Union_Union fun (i : ι) => maps_to_Union_Union (H i)

theorem maps_to_sInter {α : Type u} {β : Type v} {s : set α} {T : set (set β)} {f : α → β} (H : ∀ (t : set β), t ∈ T → maps_to f s t) : maps_to f s (⋂₀T) :=
  fun (x : α) (hx : x ∈ s) (t : set β) (ht : t ∈ T) => H t ht hx

theorem maps_to_Inter {α : Type u} {β : Type v} {ι : Sort x} {s : set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), maps_to f s (t i)) : maps_to f s (Inter fun (i : ι) => t i) :=
  fun (x : α) (hx : x ∈ s) => iff.mpr mem_Inter fun (i : ι) => H i hx

theorem maps_to_bInter {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : set α} {t : (i : ι) → p i → set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), maps_to f s (t i hi)) : maps_to f s (Inter fun (i : ι) => Inter fun (hi : p i) => t i hi) :=
  maps_to_Inter fun (i : ι) => maps_to_Inter (H i)

theorem maps_to_Inter_Inter {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), maps_to f (s i) (t i)) : maps_to f (Inter fun (i : ι) => s i) (Inter fun (i : ι) => t i) :=
  maps_to_Inter fun (i : ι) => maps_to.mono (Inter_subset s i) (subset.refl (t i)) (H i)

theorem maps_to_bInter_bInter {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : (i : ι) → p i → set α} {t : (i : ι) → p i → set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), maps_to f (s i hi) (t i hi)) : maps_to f (Inter fun (i : ι) => Inter fun (hi : p i) => s i hi) (Inter fun (i : ι) => Inter fun (hi : p i) => t i hi) :=
  maps_to_Inter_Inter fun (i : ι) => maps_to_Inter_Inter (H i)

theorem image_Inter_subset {α : Type u} {β : Type v} {ι : Sort x} (s : ι → set α) (f : α → β) : (f '' Inter fun (i : ι) => s i) ⊆ Inter fun (i : ι) => f '' s i :=
  maps_to.image_subset (maps_to_Inter_Inter fun (i : ι) => maps_to_image f (s i))

theorem image_bInter_subset {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} (s : (i : ι) → p i → set α) (f : α → β) : (f '' Inter fun (i : ι) => Inter fun (hi : p i) => s i hi) ⊆ Inter fun (i : ι) => Inter fun (hi : p i) => f '' s i hi :=
  maps_to.image_subset (maps_to_bInter_bInter fun (i : ι) (hi : p i) => maps_to_image f (s i hi))

theorem image_sInter_subset {α : Type u} {β : Type v} (S : set (set α)) (f : α → β) : f '' ⋂₀S ⊆ Inter fun (s : set α) => Inter fun (H : s ∈ S) => f '' s :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (f '' ⋂₀S ⊆ Inter fun (s : set α) => Inter fun (H : s ∈ S) => f '' s)) sInter_eq_bInter))
    (image_bInter_subset (fun (i : set α) (hi : i ∈ S) => i) f)

/-!
### `inj_on`
-/

theorem inj_on.image_Inter_eq {α : Type u} {β : Type v} {ι : Sort x} [Nonempty ι] {s : ι → set α} {f : α → β} (h : inj_on f (Union fun (i : ι) => s i)) : (f '' Inter fun (i : ι) => s i) = Inter fun (i : ι) => f '' s i := sorry

theorem inj_on.image_bInter_eq {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : (i : ι) → p i → set α} (hp : ∃ (i : ι), p i) {f : α → β} (h : inj_on f (Union fun (i : ι) => Union fun (hi : p i) => s i hi)) : (f '' Inter fun (i : ι) => Inter fun (hi : p i) => s i hi) = Inter fun (i : ι) => Inter fun (hi : p i) => f '' s i hi := sorry

theorem inj_on_Union_of_directed {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} (hs : directed has_subset.subset s) {f : α → β} (hf : ∀ (i : ι), inj_on f (s i)) : inj_on f (Union fun (i : ι) => s i) := sorry

/-!
### `surj_on`
-/

theorem surj_on_sUnion {α : Type u} {β : Type v} {s : set α} {T : set (set β)} {f : α → β} (H : ∀ (t : set β), t ∈ T → surj_on f s t) : surj_on f s (⋃₀T) := sorry

theorem surj_on_Union {α : Type u} {β : Type v} {ι : Sort x} {s : set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), surj_on f s (t i)) : surj_on f s (Union fun (i : ι) => t i) :=
  surj_on_sUnion (iff.mpr forall_range_iff H)

theorem surj_on_Union_Union {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), surj_on f (s i) (t i)) : surj_on f (Union fun (i : ι) => s i) (Union fun (i : ι) => t i) :=
  surj_on_Union fun (i : ι) => surj_on.mono (subset_Union s i) (subset.refl (t i)) (H i)

theorem surj_on_bUnion {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : set α} {t : (i : ι) → p i → set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), surj_on f s (t i hi)) : surj_on f s (Union fun (i : ι) => Union fun (hi : p i) => t i hi) :=
  surj_on_Union fun (i : ι) => surj_on_Union (H i)

theorem surj_on_bUnion_bUnion {α : Type u} {β : Type v} {ι : Sort x} {p : ι → Prop} {s : (i : ι) → p i → set α} {t : (i : ι) → p i → set β} {f : α → β} (H : ∀ (i : ι) (hi : p i), surj_on f (s i hi) (t i hi)) : surj_on f (Union fun (i : ι) => Union fun (hi : p i) => s i hi) (Union fun (i : ι) => Union fun (hi : p i) => t i hi) :=
  surj_on_Union_Union fun (i : ι) => surj_on_Union_Union (H i)

theorem surj_on_Inter {α : Type u} {β : Type v} {ι : Sort x} [hi : Nonempty ι] {s : ι → set α} {t : set β} {f : α → β} (H : ∀ (i : ι), surj_on f (s i) t) (Hinj : inj_on f (Union fun (i : ι) => s i)) : surj_on f (Inter fun (i : ι) => s i) t := sorry

theorem surj_on_Inter_Inter {α : Type u} {β : Type v} {ι : Sort x} [hi : Nonempty ι] {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), surj_on f (s i) (t i)) (Hinj : inj_on f (Union fun (i : ι) => s i)) : surj_on f (Inter fun (i : ι) => s i) (Inter fun (i : ι) => t i) :=
  surj_on_Inter (fun (i : ι) => surj_on.mono (subset.refl (s i)) (Inter_subset (fun (i : ι) => t i) i) (H i)) Hinj

/-!
### `bij_on`
-/

theorem bij_on_Union {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), bij_on f (s i) (t i)) (Hinj : inj_on f (Union fun (i : ι) => s i)) : bij_on f (Union fun (i : ι) => s i) (Union fun (i : ι) => t i) :=
  { left := maps_to_Union_Union fun (i : ι) => bij_on.maps_to (H i),
    right := { left := Hinj, right := surj_on_Union_Union fun (i : ι) => bij_on.surj_on (H i) } }

theorem bij_on_Inter {α : Type u} {β : Type v} {ι : Sort x} [hi : Nonempty ι] {s : ι → set α} {t : ι → set β} {f : α → β} (H : ∀ (i : ι), bij_on f (s i) (t i)) (Hinj : inj_on f (Union fun (i : ι) => s i)) : bij_on f (Inter fun (i : ι) => s i) (Inter fun (i : ι) => t i) := sorry

theorem bij_on_Union_of_directed {α : Type u} {β : Type v} {ι : Sort x} {s : ι → set α} (hs : directed has_subset.subset s) {t : ι → set β} {f : α → β} (H : ∀ (i : ι), bij_on f (s i) (t i)) : bij_on f (Union fun (i : ι) => s i) (Union fun (i : ι) => t i) :=
  bij_on_Union H (inj_on_Union_of_directed hs fun (i : ι) => bij_on.inj_on (H i))

theorem bij_on_Inter_of_directed {α : Type u} {β : Type v} {ι : Sort x} [Nonempty ι] {s : ι → set α} (hs : directed has_subset.subset s) {t : ι → set β} {f : α → β} (H : ∀ (i : ι), bij_on f (s i) (t i)) : bij_on f (Inter fun (i : ι) => s i) (Inter fun (i : ι) => t i) :=
  bij_on_Inter H (inj_on_Union_of_directed hs fun (i : ι) => bij_on.inj_on (H i))

@[simp] theorem Inter_pos {α : Type u} {p : Prop} {μ : p → set α} (hp : p) : (Inter fun (h : p) => μ h) = μ hp :=
  infi_pos hp

@[simp] theorem Inter_neg {α : Type u} {p : Prop} {μ : p → set α} (hp : ¬p) : (Inter fun (h : p) => μ h) = univ :=
  infi_neg hp

@[simp] theorem Union_pos {α : Type u} {p : Prop} {μ : p → set α} (hp : p) : (Union fun (h : p) => μ h) = μ hp :=
  supr_pos hp

@[simp] theorem Union_neg {α : Type u} {p : Prop} {μ : p → set α} (hp : ¬p) : (Union fun (h : p) => μ h) = ∅ :=
  supr_neg hp

@[simp] theorem Union_empty {α : Type u} {ι : Sort x} : (Union fun (i : ι) => ∅) = ∅ :=
  supr_bot

@[simp] theorem Inter_univ {α : Type u} {ι : Sort x} : (Inter fun (i : ι) => univ) = univ :=
  infi_top

@[simp] theorem Union_eq_empty {α : Type u} {ι : Sort x} {s : ι → set α} : (Union fun (i : ι) => s i) = ∅ ↔ ∀ (i : ι), s i = ∅ :=
  supr_eq_bot

@[simp] theorem Inter_eq_univ {α : Type u} {ι : Sort x} {s : ι → set α} : (Inter fun (i : ι) => s i) = univ ↔ ∀ (i : ι), s i = univ :=
  infi_eq_top

@[simp] theorem nonempty_Union {α : Type u} {ι : Sort x} {s : ι → set α} : set.nonempty (Union fun (i : ι) => s i) ↔ ∃ (i : ι), set.nonempty (s i) := sorry

theorem image_Union {α : Type u} {β : Type v} {ι : Sort x} {f : α → β} {s : ι → set α} : (f '' Union fun (i : ι) => s i) = Union fun (i : ι) => f '' s i := sorry

theorem univ_subtype {α : Type u} {p : α → Prop} : univ = Union fun (x : α) => Union fun (h : p x) => singleton { val := x, property := h } := sorry

theorem range_eq_Union {α : Type u} {ι : Sort u_1} (f : ι → α) : range f = Union fun (i : ι) => singleton (f i) := sorry

theorem image_eq_Union {α : Type u} {β : Type v} (f : α → β) (s : set α) : f '' s = Union fun (i : α) => Union fun (H : i ∈ s) => singleton (f i) := sorry

@[simp] theorem bUnion_range {α : Type u} {β : Type v} {ι : Sort x} {f : ι → α} {g : α → set β} : (Union fun (x : α) => Union fun (H : x ∈ range f) => g x) = Union fun (y : ι) => g (f y) :=
  supr_range

@[simp] theorem bInter_range {α : Type u} {β : Type v} {ι : Sort x} {f : ι → α} {g : α → set β} : (Inter fun (x : α) => Inter fun (H : x ∈ range f) => g x) = Inter fun (y : ι) => g (f y) :=
  infi_range

@[simp] theorem bUnion_image {α : Type u} {β : Type v} {γ : Type w} {s : set γ} {f : γ → α} {g : α → set β} : (Union fun (x : α) => Union fun (H : x ∈ f '' s) => g x) = Union fun (y : γ) => Union fun (H : y ∈ s) => g (f y) :=
  supr_image

@[simp] theorem bInter_image {α : Type u} {β : Type v} {γ : Type w} {s : set γ} {f : γ → α} {g : α → set β} : (Inter fun (x : α) => Inter fun (H : x ∈ f '' s) => g x) = Inter fun (y : γ) => Inter fun (H : y ∈ s) => g (f y) :=
  infi_image

theorem Union_image_left {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) {s : set α} {t : set β} : (Union fun (a : α) => Union fun (H : a ∈ s) => f a '' t) = image2 f s t := sorry

theorem Union_image_right {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) {s : set α} {t : set β} : (Union fun (b : β) => Union fun (H : b ∈ t) => (fun (a : α) => f a b) '' s) = image2 f s t := sorry

theorem monotone_preimage {α : Type u} {β : Type v} {f : α → β} : monotone (preimage f) :=
  fun (a b : set β) (h : a ≤ b) => preimage_mono h

@[simp] theorem preimage_Union {α : Type u} {β : Type v} {ι : Sort w} {f : α → β} {s : ι → set β} : (f ⁻¹' Union fun (i : ι) => s i) = Union fun (i : ι) => f ⁻¹' s i := sorry

theorem preimage_bUnion {α : Type u} {β : Type v} {ι : Type u_1} {f : α → β} {s : set ι} {t : ι → set β} : (f ⁻¹' Union fun (i : ι) => Union fun (H : i ∈ s) => t i) = Union fun (i : ι) => Union fun (H : i ∈ s) => f ⁻¹' t i := sorry

@[simp] theorem preimage_sUnion {α : Type u} {β : Type v} {f : α → β} {s : set (set β)} : f ⁻¹' ⋃₀s = Union fun (t : set β) => Union fun (H : t ∈ s) => f ⁻¹' t := sorry

theorem preimage_Inter {α : Type u} {β : Type v} {ι : Sort u_1} {s : ι → set β} {f : α → β} : (f ⁻¹' Inter fun (i : ι) => s i) = Inter fun (i : ι) => f ⁻¹' s i := sorry

theorem preimage_bInter {α : Type u} {β : Type v} {γ : Type w} {s : γ → set β} {t : set γ} {f : α → β} : (f ⁻¹' Inter fun (i : γ) => Inter fun (H : i ∈ t) => s i) = Inter fun (i : γ) => Inter fun (H : i ∈ t) => f ⁻¹' s i := sorry

@[simp] theorem bUnion_preimage_singleton {α : Type u} {β : Type v} (f : α → β) (s : set β) : (Union fun (y : β) => Union fun (H : y ∈ s) => f ⁻¹' singleton y) = f ⁻¹' s := sorry

theorem bUnion_range_preimage_singleton {α : Type u} {β : Type v} (f : α → β) : (Union fun (y : β) => Union fun (H : y ∈ range f) => f ⁻¹' singleton y) = univ := sorry

theorem monotone_prod {α : Type u} {β : Type v} {γ : Type w} [preorder α] {f : α → set β} {g : α → set γ} (hf : monotone f) (hg : monotone g) : monotone fun (x : α) => set.prod (f x) (g x) :=
  fun (a b : α) (h : a ≤ b) => prod_mono (hf h) (hg h)

theorem Mathlib.monotone.set_prod {α : Type u} {β : Type v} {γ : Type w} [preorder α] {f : α → set β} {g : α → set γ} (hf : monotone f) (hg : monotone g) : monotone fun (x : α) => set.prod (f x) (g x) :=
  monotone_prod

theorem prod_Union {α : Type u} {β : Type v} {ι : Sort u_1} {s : set α} {t : ι → set β} : set.prod s (Union fun (i : ι) => t i) = Union fun (i : ι) => set.prod s (t i) := sorry

theorem prod_bUnion {α : Type u} {β : Type v} {ι : Type u_1} {u : set ι} {s : set α} {t : ι → set β} : set.prod s (Union fun (i : ι) => Union fun (H : i ∈ u) => t i) =
  Union fun (i : ι) => Union fun (H : i ∈ u) => set.prod s (t i) := sorry

theorem prod_sUnion {α : Type u} {β : Type v} {s : set α} {C : set (set β)} : set.prod s (⋃₀C) = ⋃₀((fun (t : set β) => set.prod s t) '' C) := sorry

theorem Union_prod {α : Type u} {β : Type v} {ι : Sort u_1} {s : ι → set α} {t : set β} : set.prod (Union fun (i : ι) => s i) t = Union fun (i : ι) => set.prod (s i) t := sorry

theorem bUnion_prod {α : Type u} {β : Type v} {ι : Type u_1} {u : set ι} {s : ι → set α} {t : set β} : set.prod (Union fun (i : ι) => Union fun (H : i ∈ u) => s i) t =
  Union fun (i : ι) => Union fun (H : i ∈ u) => set.prod (s i) t := sorry

theorem sUnion_prod {α : Type u} {β : Type v} {C : set (set α)} {t : set β} : set.prod (⋃₀C) t = ⋃₀((fun (s : set α) => set.prod s t) '' C) := sorry

theorem Union_prod_of_monotone {α : Type u} {β : Type v} {γ : Type w} [semilattice_sup α] {s : α → set β} {t : α → set γ} (hs : monotone s) (ht : monotone t) : (Union fun (x : α) => set.prod (s x) (t x)) = set.prod (Union fun (x : α) => s x) (Union fun (x : α) => t x) := sorry

/-- Given a set `s` of functions `α → β` and `t : set α`, `seq s t` is the union of `f '' t` over
all `f ∈ s`. -/
def seq {α : Type u} {β : Type v} (s : set (α → β)) (t : set α) : set β :=
  set_of fun (b : β) => ∃ (f : α → β), ∃ (H : f ∈ s), ∃ (a : α), ∃ (H : a ∈ t), f a = b

theorem seq_def {α : Type u} {β : Type v} {s : set (α → β)} {t : set α} : seq s t = Union fun (f : α → β) => Union fun (H : f ∈ s) => f '' t := sorry

@[simp] theorem mem_seq_iff {α : Type u} {β : Type v} {s : set (α → β)} {t : set α} {b : β} : b ∈ seq s t ↔ ∃ (f : α → β), ∃ (H : f ∈ s), ∃ (a : α), ∃ (H : a ∈ t), f a = b :=
  iff.rfl

theorem seq_subset {α : Type u} {β : Type v} {s : set (α → β)} {t : set α} {u : set β} : seq s t ⊆ u ↔ ∀ (f : α → β), f ∈ s → ∀ (a : α), a ∈ t → f a ∈ u := sorry

theorem seq_mono {α : Type u} {β : Type v} {s₀ : set (α → β)} {s₁ : set (α → β)} {t₀ : set α} {t₁ : set α} (hs : s₀ ⊆ s₁) (ht : t₀ ⊆ t₁) : seq s₀ t₀ ⊆ seq s₁ t₁ := sorry

theorem singleton_seq {α : Type u} {β : Type v} {f : α → β} {t : set α} : seq (singleton f) t = f '' t := sorry

theorem seq_singleton {α : Type u} {β : Type v} {s : set (α → β)} {a : α} : seq s (singleton a) = (fun (f : α → β) => f a) '' s := sorry

theorem seq_seq {α : Type u} {β : Type v} {γ : Type w} {s : set (β → γ)} {t : set (α → β)} {u : set α} : seq s (seq t u) = seq (seq (function.comp '' s) t) u := sorry

theorem image_seq {α : Type u} {β : Type v} {γ : Type w} {f : β → γ} {s : set (α → β)} {t : set α} : f '' seq s t = seq (function.comp f '' s) t := sorry

theorem prod_eq_seq {α : Type u} {β : Type v} {s : set α} {t : set β} : set.prod s t = seq (Prod.mk '' s) t := sorry

theorem prod_image_seq_comm {α : Type u} {β : Type v} (s : set α) (t : set β) : seq (Prod.mk '' s) t = seq ((fun (b : β) (a : α) => (a, b)) '' t) s := sorry

theorem image2_eq_seq {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) (s : set α) (t : set β) : image2 f s t = seq (f '' s) t := sorry

protected instance monad : Monad set :=
  { toApplicative :=
      { toFunctor := { map := fun (α β : Type u) => image, mapConst := fun (α β : Type u) => image ∘ function.const β },
        toPure := { pure := fun (α : Type u) (a : α) => singleton a }, toSeq := { seq := fun (α β : Type u) => seq },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u) (a : set α) (b : set β) =>
                (fun (α β : Type u) => seq) β α ((fun (α β : Type u) => image) α (β → α) (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u) (a : set α) (b : set β) =>
                (fun (α β : Type u) => seq) β β ((fun (α β : Type u) => image) α (β → β) (function.const α id) a) b } },
    toBind :=
      { bind := fun (α β : Type u) (s : set α) (f : α → set β) => Union fun (i : α) => Union fun (H : i ∈ s) => f i } }

@[simp] theorem bind_def {α' : Type u} {β' : Type u} {s : set α'} {f : α' → set β'} : s >>= f = Union fun (i : α') => Union fun (H : i ∈ s) => f i :=
  rfl

@[simp] theorem fmap_eq_image {α' : Type u} {β' : Type u} {s : set α'} (f : α' → β') : f <$> s = f '' s :=
  rfl

@[simp] theorem seq_eq_set_seq {α : Type u_1} {β : Type u_1} (s : set (α → β)) (t : set α) : s <*> t = seq s t :=
  rfl

@[simp] theorem pure_def {α : Type u} (a : α) : pure a = singleton a :=
  rfl

protected instance is_lawful_monad : is_lawful_monad set := sorry

protected instance is_comm_applicative : is_comm_applicative set :=
  is_comm_applicative.mk fun (α β : Type u) (s : set α) (t : set β) => prod_image_seq_comm s t

theorem pi_def {α : Type u} {π : α → Type u_1} (i : set α) (s : (a : α) → set (π a)) : pi i s = Inter fun (a : α) => Inter fun (H : a ∈ i) => function.eval a ⁻¹' s a := sorry

theorem pi_diff_pi_subset {α : Type u} {π : α → Type u_1} (i : set α) (s : (a : α) → set (π a)) (t : (a : α) → set (π a)) : pi i s \ pi i t ⊆ Union fun (a : α) => Union fun (H : a ∈ i) => function.eval a ⁻¹' (s a \ t a) := sorry

end set

/-! ### Disjoint sets -/

namespace disjoint

/-! We define some lemmas in the `disjoint` namespace to be able to use projection notation. -/

theorem union_left {α : Type u} {s : set α} {t : set α} {u : set α} (hs : disjoint s u) (ht : disjoint t u) : disjoint (s ∪ t) u :=
  sup_left hs ht

theorem union_right {α : Type u} {s : set α} {t : set α} {u : set α} (ht : disjoint s t) (hu : disjoint s u) : disjoint s (t ∪ u) :=
  sup_right ht hu

theorem preimage {α : Type u_1} {β : Type u_2} (f : α → β) {s : set β} {t : set β} (h : disjoint s t) : disjoint (f ⁻¹' s) (f ⁻¹' t) :=
  fun (x : α) (hx : x ∈ f ⁻¹' s ⊓ f ⁻¹' t) => h hx

end disjoint

namespace set

protected theorem disjoint_iff {α : Type u} {s : set α} {t : set α} : disjoint s t ↔ s ∩ t ⊆ ∅ :=
  iff.rfl

theorem disjoint_iff_inter_eq_empty {α : Type u} {s : set α} {t : set α} : disjoint s t ↔ s ∩ t = ∅ :=
  disjoint_iff

theorem not_disjoint_iff {α : Type u} {s : set α} {t : set α} : ¬disjoint s t ↔ ∃ (x : α), x ∈ s ∧ x ∈ t :=
  iff.trans not_forall (exists_congr fun (x : α) => not_not)

theorem disjoint_left {α : Type u} {s : set α} {t : set α} : disjoint s t ↔ ∀ {a : α}, a ∈ s → ¬a ∈ t :=
  (fun (this : (∀ (x : α), ¬x ∈ s ∩ t) ↔ ∀ (a : α), a ∈ s → ¬a ∈ t) => this)
    { mp := fun (h : ∀ (x : α), ¬x ∈ s ∩ t) (a : α) => iff.mp not_and (h a),
      mpr := fun (h : ∀ (a : α), a ∈ s → ¬a ∈ t) (a : α) => iff.mpr not_and (h a) }

theorem disjoint_right {α : Type u} {s : set α} {t : set α} : disjoint s t ↔ ∀ {a : α}, a ∈ t → ¬a ∈ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (disjoint s t ↔ ∀ {a : α}, a ∈ t → ¬a ∈ s)) (propext disjoint.comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (disjoint t s ↔ ∀ {a : α}, a ∈ t → ¬a ∈ s)) (propext disjoint_left)))
      (iff.refl (∀ {a : α}, a ∈ t → ¬a ∈ s)))

theorem disjoint_of_subset_left {α : Type u} {s : set α} {t : set α} {u : set α} (h : s ⊆ u) (d : disjoint u t) : disjoint s t :=
  disjoint.mono_left h d

theorem disjoint_of_subset_right {α : Type u} {s : set α} {t : set α} {u : set α} (h : t ⊆ u) (d : disjoint s u) : disjoint s t :=
  disjoint.mono_right h d

theorem disjoint_of_subset {α : Type u} {s : set α} {t : set α} {u : set α} {v : set α} (h1 : s ⊆ u) (h2 : t ⊆ v) (d : disjoint u v) : disjoint s t :=
  disjoint.mono h1 h2 d

@[simp] theorem disjoint_union_left {α : Type u} {s : set α} {t : set α} {u : set α} : disjoint (s ∪ t) u ↔ disjoint s u ∧ disjoint t u :=
  disjoint_sup_left

@[simp] theorem disjoint_union_right {α : Type u} {s : set α} {t : set α} {u : set α} : disjoint s (t ∪ u) ↔ disjoint s t ∧ disjoint s u :=
  disjoint_sup_right

theorem disjoint_diff {α : Type u} {a : set α} {b : set α} : disjoint a (b \ a) :=
  iff.mpr disjoint_iff (inter_diff_self a b)

@[simp] theorem disjoint_empty {α : Type u} (s : set α) : disjoint s ∅ :=
  disjoint_bot_right

@[simp] theorem empty_disjoint {α : Type u} (s : set α) : disjoint ∅ s :=
  disjoint_bot_left

@[simp] theorem univ_disjoint {α : Type u} {s : set α} : disjoint univ s ↔ s = ∅ :=
  top_disjoint

@[simp] theorem disjoint_univ {α : Type u} {s : set α} : disjoint s univ ↔ s = ∅ :=
  disjoint_top

@[simp] theorem disjoint_singleton_left {α : Type u} {a : α} {s : set α} : disjoint (singleton a) s ↔ ¬a ∈ s := sorry

@[simp] theorem disjoint_singleton_right {α : Type u} {a : α} {s : set α} : disjoint s (singleton a) ↔ ¬a ∈ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (disjoint s (singleton a) ↔ ¬a ∈ s)) (propext disjoint.comm))) disjoint_singleton_left

theorem disjoint_image_image {α : Type u} {β : Type v} {γ : Type w} {f : β → α} {g : γ → α} {s : set β} {t : set γ} (h : ∀ (b : β), b ∈ s → ∀ (c : γ), c ∈ t → f b ≠ g c) : disjoint (f '' s) (g '' t) := sorry

theorem pairwise_on_disjoint_fiber {α : Type u} {β : Type v} (f : α → β) (s : set β) : pairwise_on s (disjoint on fun (y : β) => f ⁻¹' singleton y) := sorry

theorem preimage_eq_empty {α : Type u} {β : Type v} {f : α → β} {s : set β} (h : disjoint s (range f)) : f ⁻¹' s = ∅ := sorry

theorem preimage_eq_empty_iff {α : Type u} {β : Type v} {f : α → β} {s : set β} : disjoint s (range f) ↔ f ⁻¹' s = ∅ := sorry

end set

namespace set

/-- A collection of sets is `pairwise_disjoint`, if any two different sets in this collection
are disjoint.  -/
def pairwise_disjoint {α : Type u} (s : set (set α)) :=
  pairwise_on s disjoint

theorem pairwise_disjoint.subset {α : Type u} {s : set (set α)} {t : set (set α)} (h : s ⊆ t) (ht : pairwise_disjoint t) : pairwise_disjoint s :=
  pairwise_on.mono h ht

theorem pairwise_disjoint.range {α : Type u} {s : set (set α)} (f : ↥s → set α) (hf : ∀ (x : ↥s), f x ⊆ subtype.val x) (ht : pairwise_disjoint s) : pairwise_disjoint (range f) := sorry

/- classical -/

theorem pairwise_disjoint.elim {α : Type u} {s : set (set α)} (h : pairwise_disjoint s) {x : set α} {y : set α} (hx : x ∈ s) (hy : y ∈ s) (z : α) (hzx : z ∈ x) (hzy : z ∈ y) : x = y :=
  iff.mp not_not fun (h' : ¬x = y) => h x hx y hy h' { left := hzx, right := hzy }

end set

namespace set

theorem subset_diff {α : Type u} {s : set α} {t : set α} {u : set α} : s ⊆ t \ u ↔ s ⊆ t ∧ disjoint s u := sorry

/-- If `t` is an indexed family of sets, then there is a natural map from `Σ i, t i` to `⋃ i, t i`
sending `⟨i, x⟩` to `x`. -/
def sigma_to_Union {α : Type u} {β : Type v} (t : α → set β) (x : sigma fun (i : α) => ↥(t i)) : ↥(Union fun (i : α) => t i) :=
  { val := ↑(sigma.snd x), property := sorry }

theorem sigma_to_Union_surjective {α : Type u} {β : Type v} (t : α → set β) : function.surjective (sigma_to_Union t) := sorry

theorem sigma_to_Union_injective {α : Type u} {β : Type v} (t : α → set β) (h : ∀ (i j : α), i ≠ j → disjoint (t i) (t j)) : function.injective (sigma_to_Union t) := sorry

theorem sigma_to_Union_bijective {α : Type u} {β : Type v} (t : α → set β) (h : ∀ (i j : α), i ≠ j → disjoint (t i) (t j)) : function.bijective (sigma_to_Union t) :=
  { left := sigma_to_Union_injective t h, right := sigma_to_Union_surjective t }

/-- Equivalence between a disjoint union and a dependent sum. -/
def Union_eq_sigma_of_disjoint {α : Type u} {β : Type v} {t : α → set β} (h : ∀ (i j : α), i ≠ j → disjoint (t i) (t j)) : ↥(Union fun (i : α) => t i) ≃ sigma fun (i : α) => ↥(t i) :=
  equiv.symm (equiv.of_bijective (sigma_to_Union t) (sigma_to_Union_bijective t h))

/-- Equivalence between a disjoint bounded union and a dependent sum. -/
def bUnion_eq_sigma_of_disjoint {α : Type u} {β : Type v} {s : set α} {t : α → set β} (h : pairwise_on s (disjoint on t)) : ↥(Union fun (i : α) => Union fun (H : i ∈ s) => t i) ≃ sigma fun (i : ↥s) => ↥(t (subtype.val i)) :=
  equiv.trans (equiv.set_congr sorry) (Union_eq_sigma_of_disjoint sorry)


import data.nat.enat
import data.real.basic
import data.real.cau_seq
import data.nat.choose.basic
import algebra.group_power.basic
import ring_theory.ideal.basic
import ring_theory.principal_ideal_domain
import ring_theory.unique_factorization_domain
import analysis.special_functions.pow
import topology.basic

import for_mathlib.associated
import for_mathlib.multiplicity
import for_mathlib.principal_ideal_domain

open is_absolute_value
open_locale classical big_operators
noncomputable theory

set_option old_structure_cmd true

def padic_val {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α]
    (p: α) [p_prime: fact (prime p)] (a: α): ℕ :=
  if a ≠ 0
      then multiset.count (normalize p) (unique_factorization_monoid.factors a)
      else 0

lemma padic_val_mul {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (p: α) [p_prime: fact (prime p)] (a b: α) (ha: a ≠ 0) (hb: b ≠ 0):
  padic_val p (a * b) = padic_val p a + padic_val p b :=
begin
  unfold padic_val,
  simp [ha, hb],
end

lemma padic_val_add {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (p: α) [p_prime: fact (prime p)] {a b: α} (add_ne_zero: a + b ≠ 0):
    padic_val p (a + b) ≥ min (padic_val p a) (padic_val p b) :=
begin
  unfold padic_val,
  exact if ha: a = 0
    then by { simp [ha], }
    else if hb: b = 0
    then by { simp [hb], }
    else by {
      have h: multiplicity p (a + b) ≥ min (multiplicity p a) (multiplicity p b),
      from multiplicity.min_le_multiplicity_add,
      have p₀ := λ a: α, λ p: a ≠ 0,
        unique_factorization_monoid.multiplicity_eq_count_factors
          (fact_iff.1 p_prime).irreducible p,
      rw p₀ _ add_ne_zero at h,
      rw p₀ _ ha at h,
      rw p₀ _ hb at h,
      finish,
    },
end

lemma padic_val_primes {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (p: α) [p_prime: fact (prime p)]: ∀ q: α, prime q →
    padic_val p q = if associated q p then 1 else 0 :=
begin
  intros q q_prime,
  unfold padic_val,
  simp only [q_prime.left, if_true, if_false, ne.def, not_false_iff],
  rw ← enat.coe_inj,
  rw eq.symm (unique_factorization_monoid.multiplicity_eq_count_factors
    (fact_iff.1 p_prime).irreducible q_prime.1),
  exact if hpq: associated q p
    then by simp [hpq, multiplicity.eq_of_associated hpq,
      multiplicity.multiplicity_self (fact_iff.1 p_prime).not_unit (fact_iff.1 p_prime).ne_zero]
    else by simp [hpq, multiplicity.multiplicity_eq_zero_of_not_dvd
      (λ h, hpq (primes_associated_of_dvd (fact_iff.1 p_prime) q_prime h).symm)]
end

lemma padic_val_units {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (p: α) [p_prime: fact (prime p)]: ∀ u: units α, padic_val p u = 0 :=
begin
  intro u,
  unfold padic_val,
  simp only [u.ne_zero, if_true, ne.def, not_false_iff],
  rw ← enat.coe_inj,
  rw eq.symm (unique_factorization_monoid.multiplicity_eq_count_factors
    (fact_iff.1 p_prime).irreducible u.ne_zero),
  exact multiplicity.unit_right (fact_iff.1 p_prime).not_unit u,
end

def padic_abv {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α]
    (base: ℝ) (base_pos: 0 < base) (base_lt_one: base < 1)
    (p: α) [p_prime: fact (prime p)]: α → ℝ :=
  λ a: α, if a = 0 then 0 else base ^ padic_val p a

instance padic_abv_is_absolute_value {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (base: ℝ) (base_pos: 0 < base) (base_lt_one: base < 1)
  (p: α) [p_prime: fact (prime p)] :
    is_absolute_value (padic_abv base base_pos base_lt_one p) :=
{
  abv_nonneg := by {
    intro a, unfold padic_abv, split_ifs, refl,
    apply pow_nonneg, exact le_of_lt base_pos,
  },
  abv_eq_zero := by {
    intro a, unfold padic_abv, split_ifs, tauto,
    finish [pow_ne_zero (padic_val p a) (ne.symm $ ne_of_lt base_pos)],
  },
  abv_add := by {
    intros x y,
    unfold padic_abv,
    have pow_x_pos := pow_pos base_pos (padic_val p x),
    have pow_y_pos := pow_pos base_pos (padic_val p y),
    exact if hx: x = 0 then
        by { simp [hx], }
      else if hy: y = 0 then
        by { simp [hy], }
      else if hxy: x + y = 0 then
        by {
          simp [hx, hy, hxy],
          linarith only [pow_x_pos, pow_y_pos],
        }
      else by {
        suffices p₁: real.rpow base (padic_val p (x + y)) ≤
          max
            (real.rpow base (padic_val p x))
            (real.rpow base (padic_val p y)),
        {
          have p₂ := max_le_add_of_nonneg (le_of_lt pow_x_pos) (le_of_lt pow_y_pos),
          repeat { rw [real.rpow_eq_pow, real.rpow_nat_cast] at p₁, },
          simp [hx, hy, hxy, le_trans p₁ p₂],
        },

        set c := base⁻¹ with c_def,
        obtain ⟨ one_lt_c, base_rw, c_nonneg ⟩: 1 < c ∧ base = c⁻¹ ∧ 0 ≤ c,
        {
          rw c_def,
          rw inv_inv',
          exact ⟨ one_lt_inv base_pos base_lt_one, rfl,
            inv_nonneg.2 $ le_of_lt base_pos ⟩,
        },
        have pow_c_mono: monotone (pow c),
        from λ a b h, real.rpow_le_rpow_of_exponent_le (le_of_lt one_lt_c) h,

        have p₀ := (int.neg_le_neg $ int.coe_nat_le.2 $ padic_val_add p hxy),

        repeat { rw base_rw, },
        repeat { rw real.rpow_eq_pow, },
        repeat { rw real.inv_rpow c_nonneg, },
        repeat { rw ← real.rpow_neg c_nonneg, },
        rw ← monotone.map_max pow_c_mono,
        rw ← ge_iff_le at p₀,
        rw max_neg_neg,
        rw ← monotone.map_min,
        {
          apply pow_c_mono,
          exact_mod_cast p₀,
        },
        exact nat.mono_cast,
      },
  },
  abv_mul := by {
    intros x y,
    unfold padic_abv,
    exact if hx: x = 0 then
      by simp [hx]
    else if hy: y = 0 then
      by simp [hy]
    else by { simp [hx, hy, padic_val_mul p x y, pow_add _ _ _], },
  },
}

lemma padic_abv_primes {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α]
    (base: ℝ) (base_pos: 0 < base) (base_lt_one: base < 1)
    (p: α) [p_prime: fact (prime p)]:
      ∀ q: α, prime q →
      padic_abv base base_pos base_lt_one p q =
        if associated q p then base else 1 :=
begin
  intros q q_prime,
  unfold padic_abv,
  rw padic_val_primes p q q_prime,
  simp [q_prime.1],
end

lemma padic_abv_bounded {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α]
    (base: ℝ) (base_pos: 0 < base) (base_lt_one: base < 1)
    (p: α) [p_prime: fact (prime p)]:
      ∀ a: α, padic_abv base base_pos base_lt_one p a ≤ 1 :=
begin
  set abv := (padic_abv base base_pos base_lt_one p) with abv_def,

  intro a,
  refine wf_dvd_monoid.induction_on_irreducible a ((abv_zero abv).symm ▸ zero_le_one) _ _,
  {
    rintros _ ⟨ u, rfl ⟩,
    rw abv_def,
    unfold padic_abv,
    simp [padic_val_units p u],
  },
  {
    intros a q ha hq abva_le_one,
    rw abv_mul abv,
    convert mul_le_mul _ abva_le_one (abv_nonneg abv a) (zero_le_one),
    rw one_mul,
    rw principal_ideal_ring.irreducible_iff_prime at hq,
    rw [abv_def, padic_abv_primes base base_pos base_lt_one p q hq],
    by_cases hpq: associated q p; simp [hpq, if_true, le_of_lt base_lt_one],
  },
end

def sample_padic_abv {α} [integral_domain α] [is_principal_ideal_ring α]
  [normalization_monoid α]
  (p: α) [p_prime: fact (prime p)]: α → ℝ :=
    padic_abv (1/2) one_half_pos one_half_lt_one p

instance sample_padic_abv_is_absolute_value {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α]
    (p: α) [p_prime: fact (prime p)]: is_absolute_value (sample_padic_abv p) :=
  padic_abv_is_absolute_value (1/2) one_half_pos one_half_lt_one p

lemma sample_padic_abv_on_primes {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α] (p: α) [p_prime: fact (prime p)]:
      ∀ q: α, prime q →
      sample_padic_abv p q = if associated q p then 1/2 else 1 :=
padic_abv_primes (1/2) one_half_pos one_half_lt_one p

lemma sample_padic_abv_bounded {α} [integral_domain α] [is_principal_ideal_ring α]
    [normalization_monoid α] (p: α) [p_prime: fact (prime p)]:
      ∀ a: α, sample_padic_abv p a ≤ 1 :=
padic_abv_bounded (1/2) one_half_pos one_half_lt_one p

def hom_of_abv {α} [linear_ordered_field α] {β} [ring β] [nontrivial β]
  (abv: β → α) [is_absolute_value abv]:
  monoid_with_zero_hom β α :=
{
  to_fun := abv,
  map_zero' := abv_zero abv,
  map_one' := abv_one abv,
  map_mul' := abv_mul abv,
}

def hom_of_equiv {α} [comm_ring α]
  (φ: monoid_with_zero_hom α ℝ) (a: ℝ) (a_pos: 0 < a)
  (nonneg: ∀ a: α, 0 ≤ φ a):
  monoid_with_zero_hom α ℝ :=
{
  to_fun := (λ r, (φ r) ^ a),
  map_zero' := by {
    rw [← monoid_with_zero_hom.to_fun_eq_coe, φ.map_zero'],
    exact real.zero_rpow (ne.symm $ ne_of_lt a_pos),
  },
  map_one' := by {
    rw [← monoid_with_zero_hom.to_fun_eq_coe, φ.map_one'],
    exact real.one_rpow a,
  },
  map_mul' := by {
    intros x y,
    rw [← monoid_with_zero_hom.to_fun_eq_coe, φ.map_mul'],
    have p: ∀ a: α, 0 ≤ φ.to_fun a := nonneg,
    rw real.mul_rpow (p x) (p y),
  },
}


import japanese_bracket
import analysis.schwartz_space

noncomputable theory

open_locale big_operators nnreal filter topological_space ennreal schwartz_space

open asymptotics filter set real measure_theory finite_dimensional

variables {E F : Type*}

namespace schwartz_map

variables [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
variables [measure_space E] [borel_space E] [(@volume E _).is_add_haar_measure]
variables [normed_add_comm_group F] [normed_space ℝ F]

@[protected, measurability] lemma ae_strongly_measurable (f : 𝓢(E, F)) : ae_strongly_measurable (f : E → F) volume :=
f.continuous.ae_strongly_measurable

lemma one_add_pow_smul_le (f : 𝓢(E, F)) (x : E) (n : ℕ): ∥(1 + ∥x∥) ^ n • f x∥ ≤
  ∑ (m : ℕ) in finset.range (n + 1), (n.choose m : ℝ) * (schwartz_map.seminorm ℝ m 0) f :=
begin
  rw add_comm,
  rw add_pow,
  rw finset.sum_smul,
  simp only [one_pow, mul_one],
  refine (norm_sum_le (finset.range (n + 1)) _).trans _,
  refine finset.sum_le_sum (λ m hm, _),
  rw mul_comm,
  simp only [←smul_smul, norm_smul, norm_coe_nat, norm_pow, norm_norm],
  exact mul_le_mul_of_nonneg_left (f.norm_pow_mul_le_seminorm ℝ _ _) (by positivity),
end

/-- To be generalized to all p -/
@[protected] lemma mem_ℒp_one (f : 𝓢(E, F)) : mem_ℒp (f : E → F) 1 volume :=
begin
  have hr : (finrank ℝ E : ℝ) < finrank ℝ E + 1 := lt_add_one (finrank ℝ E),
  have h := mem_ℒp_rpow_neg_one_add_norm hr,
  let c := ∑ (m : ℕ) in finset.range ((finrank ℝ E + 1) + 1),
    ((finrank ℝ E + 1).choose m : ℝ) * (schwartz_map.seminorm ℝ m 0) f,
  have h' : ∀ x : E, ∥f x∥ ≤ c * ∥(1 + ∥x∥) ^ -((finrank ℝ E : ℝ) + 1)∥ :=
  begin
    intros x,
    have hpos : 0 < 1 + ∥x∥ := by positivity,
    rw ←one_smul ℝ (f x),
    nth_rewrite 0 ←real.rpow_zero (1 + ∥x∥),
    rw ←sub_self ((finrank ℝ E : ℝ) + 1),
    rw sub_eq_neg_add,
    rw real.rpow_add hpos,
    rw ←smul_smul,
    rw norm_smul,
    rw mul_comm,
    refine mul_le_mul_of_nonneg_right _ (by positivity),
    norm_cast,
    exact one_add_pow_smul_le _ _ _,
  end,
  exact h.of_le_mul (by measurability) (ae_of_all _ h'),
end

@[protected] lemma integrable (f : 𝓢(E, F)) : integrable (f : E → F) :=
begin
  rw ←mem_ℒp_one_iff_integrable,
  exact f.mem_ℒp_one,
end

end schwartz_map

section fourier_transform_aux

variables [inner_product_space ℝ E]
variables [normed_add_comm_group F] [normed_space ℝ F] [complete_space F] [finite_dimensional ℝ F]
variables [has_smul ℂ F]

lemma complex.differentiable_at_coe {f : E → ℝ} {x : E} (hf : differentiable_at ℝ f x) :
  differentiable_at ℝ (λ y, (f y : ℂ)) x :=
complex.of_real_clm.differentiable_at.comp _ hf

lemma complex.differentiable_coe {f : E → ℝ} (hf : differentiable ℝ f) :
  differentiable ℝ (λ x, (f x : ℂ)) :=
complex.of_real_clm.differentiable.comp hf

lemma complex.fderiv_coe {f : E → ℝ} {y : E} (hf : differentiable_at ℝ f y) :
  fderiv ℝ (λ x, (f x : ℂ)) y = complex.of_real_clm.comp (fderiv ℝ f y) :=
begin
  change fderiv ℝ (λ x, complex.of_real_clm (f x)) y = complex.of_real_clm.comp (fderiv ℝ f y),
  convert fderiv.comp _ complex.of_real_clm.differentiable_at hf,
  exact complex.of_real_clm.fderiv.symm,
end

lemma complex.fderiv_exp {f : E → ℂ} {x : E} (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λ x, complex.exp (f x)) x = complex.exp (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.cexp.fderiv

lemma inner_differentiable_at {y : E} {z : E} : differentiable_at ℝ (λ x, @inner ℝ _ _ y x) z :=
(@innerSL ℝ _ _ _ y).differentiable_at

lemma inner_differentiable {y : E} : differentiable ℝ (λ x, @inner ℝ _ _ y x) :=
(@innerSL ℝ _ _ _ y).differentiable

lemma fderiv_inner {y x₀ : E} : fderiv ℝ (λ x, @inner ℝ _ _ y x) x₀ = innerSL y :=
(@innerSL ℝ _ _ _ y).fderiv

lemma fderiv_exp_inner_left (x₀ ξ : E) : fderiv ℝ (λ x, complex.exp (- complex.I * @inner ℝ _ _ x ξ)) x₀ =
  (complex.exp (-complex.I * (@inner ℝ _ _ x₀ ξ)) * -complex.I) • complex.of_real_clm.comp (innerSL ξ) :=
begin
  have hdiff_inner : differentiable_at ℝ (λ (x : E), ↑(inner ξ x)) x₀ :=
  (complex.differentiable_coe inner_differentiable).differentiable_at,
  have hdiff_inner' : differentiable_at ℝ (λ (x : E), -complex.I * ↑(inner ξ x)) x₀ :=
  differentiable_at.const_mul hdiff_inner _,
  --((complex.differentiable_coe inner_differentiable).const_mul _).differentiable_at,
  simp_rw real_inner_comm,
  rw complex.fderiv_exp hdiff_inner',
  rw fderiv_const_mul hdiff_inner,
  rw complex.fderiv_coe inner_differentiable_at,
  rw fderiv_inner,
  rw ←mul_smul,
  simp only [real_inner_comm x₀ ξ],
  /-simp_rw real_inner_comm,
  rw ←fderiv_exp_inner_left ξ₀ x,
  congr,
  ext1,
  rw real_inner_comm,-/
end

lemma fderiv_exp_inner_right (ξ₀ x : E) : fderiv ℝ (λ ξ, complex.exp (- complex.I * @inner ℝ _ _ x ξ)) ξ₀ =
  (complex.exp (-complex.I * (@inner ℝ _ _ x ξ₀)) * -complex.I) • complex.of_real_clm.comp (innerSL x) :=
begin
  have hdiff_inner : differentiable_at ℝ (λ (ξ : E), ↑(inner x ξ)) ξ₀ :=
  (complex.differentiable_coe inner_differentiable).differentiable_at,
  have hdiff_inner' : differentiable_at ℝ (λ (ξ : E), -complex.I * ↑(inner x ξ)) ξ₀ :=
  differentiable_at.const_mul hdiff_inner _,
  rw complex.fderiv_exp hdiff_inner',
  rw fderiv_const_mul hdiff_inner,
  rw complex.fderiv_coe inner_differentiable_at,
  rw fderiv_inner,
  rw ←mul_smul,
end

end fourier_transform_aux

.

section normedC

variables [inner_product_space ℝ E]
variables [normed_add_comm_group F] [normed_space ℝ F] [complete_space F] [finite_dimensional ℝ F]
variables [normed_space ℂ F]

variables (c : ℂ)

def innerSL_mul (f : 𝓢(E, F)) : 𝓢(E, E →L[ℝ] F) :=
{ to_fun := λ x, ((@continuous_linear_map.lsmul ℝ F _ _ _ ℝ _ _ _ _).flip (f x)).comp (innerSL x),
  -- not clear whether this is the correct definition
  smooth' := sorry,
  decay' := sorry,
}

variables (x : E) (f : 𝓢(E, F)) (g : 𝓢(E, E→L[ℝ] F))

#check c • g

#check complex.of_real_clm.comp (innerSL x)
#check f x
#check ((@continuous_linear_map.lsmul ℝ F _ _ _ ℝ _ _ _ _).flip (f x)).comp (innerSL x)
#check (@continuous_linear_map.lsmul ℂ F _ _ _ ℂ _ _ _ _).flip (f x)--F →L[ℝ] ℝ →L[ℝ] F)

#check λ y, complex.of_real_clm.comp (innerSL x) y • f x

end normedC

#exit

variables [measure_space E] --[borel_space E] [(@volume E _).is_add_haar_measure]

/-- The Fourier transform -/
def fourier_transform_aux (f : E → F) (ξ : E) : F :=
  (2 * real.pi)^(-(finrank ℝ E : ℝ) / 2) • ∫ x, complex.exp (- complex.I * (@inner ℝ _ _ x ξ)) • f x

def fourier_transform (f : 𝓢(E, F)) : 𝓢(E, F) :=
  { to_fun := fourier_transform_aux f,
    smooth' := begin
      rw cont_diff_top,
      intro n,
      sorry,
    end,
    decay' := begin
      intros k n,
      sorry,
    end }

end fourier_transform


import tactic.congrm

variables {X : Type*} [has_add X] [has_mul X] (a b c d : X) (f : X → X)

example (H : a = b) : f a + f a = f b + f b :=
by congrm f _ + f _; exact H

example {g : X → X} (H : a = b) (H' : c + f a = c + f d) (H'' : f d = f b) :
  f (g a) * (f d + (c + f a)) = f (g b) * (f b + (c + f d)) :=
begin
  congrm f (g _) * (_ + _),
  { exact H },
  { exact H'' },
  { exact H' },
end

example (H' : c + (f a) = c + (f d)) (H'' : f d = f b) :
  f (f a) * (f d + (c + f a)) = f (f a) * (f b + (c + f d)) :=
begin
  congrm f (f _) * (_ + _),
  { exact H'' },
  { exact H' },
end

example (H' : c + (f a) = c + (f d)) (H'' : f d = f b) :
  f (f a) * (f d + (c + f a)) = f (f a) * (f b + (c + f d)) :=
begin
  congrm f (f _) * (_ + _),
  { exact H'' },
  { exact H' },
end

example {p q} [decidable p] [decidable q] (h : p ↔ q) :
  ite p 0 1 = ite q 0 1 :=
begin
  congrm ite _ 0 1,
  exact h,
end

example {p q} [decidable p] [decidable q] (h : p ↔ q) :
  ite p 0 1 = ite q 0 1 :=
begin
  congrm ite _ 0 1,
  exact h,
end

example {a b : ℕ} (h : a = b) : (λ y : ℕ, ∀ z, a + a = z) = (λ x, ∀ z, b + a = z) :=
begin
  congrm λ x, ∀ w, _ + a = w,
  exact h,
end

example (h : 5 = 3) : (⟨5 + 1, dec_trivial⟩ : fin 10) = ⟨3 + 1, dec_trivial⟩ :=
begin
  congrm ⟨_ + 1, _⟩,
  exact h,
end

example : true ∧ false ↔ (true ∧ true) ∧ false :=
begin
  congrm _ ∧ _,
  exact (true_and true).symm,
end

example {f g : ℕ → ℕ → ℕ} (h : f = g) : (λ i j, f i j) = (λ i j, g i j) :=
begin
  congrm λ i j, _,
  guard_target f i j = g i j,
  rw h,
end

example : true ∧ false ↔ (true ∧ true) ∧ false :=
begin
  congrm _₂ _ _,
  exact (true_and true).symm,
end

example {g : X → X} (H : a = b) (H' : c + f a = c + f d) (H'' : f d = f b) :
  f (g a) * (f d + (c + f a)) = f (g b) * (f b + (c + f d)) :=
begin
  congrm _₂ (f (_₁ _)) (_₂ _ _),
  { exact H },
  { exact H'' },
  { exact H' },
end

example {A B C D E : Type*} [has_add A] [has_mul C] {a1 a2 a3 : A} (b1 b2 : B) {c1 c2 c3 : C}
  (d1 d2 : D) (r : A → B → C → D → E)
  (a23 : a2 = a3) (b12 : b1 = b2) (c23 : c2 = c3) (d12 : d1 = d2) :
  r (a1 + a2) b1 (c1 * c2) d1 = r (a1 + a3) b2 (c1 * c3) d2 :=
by congrm _₄ (_₂ _ _) _ (_₂ _ _) _; assumption

example {A B C D : Type*} [has_add A] [has_mul C] {a1 a2 a3 : A} (b1 b2 : B) {c1 c2 c3 : C}
  (r : A → B → C → D)
  (a23 : a2 = a3) (b12 : b1 = b2) (c23 : c2 = c3) :
  r (a1 + a2) b1 (c1 * c2) = r (a1 + a3) b2 (c1 * c3) :=
by congrm _₃ (_₂ _ _) _ (_₂ _ _); assumption

example {A : Type*} (s : A → ℕ) {a1 a3 : ℕ} {a4 a5 : A} (a45 : a4 = a5) :
  (a1 + (s a4)) * a3 = (a1 + (s a5)) * a3 :=
begin
  congrm _₂ (_ + (_₁ _)) _,
  exact a45,
end

example {A B C : Type*} [has_add A] [has_mul B] {a1 a2 a3 : A} (b1 b2 b3 : B)
  (r : A → B → C) (a23 : a2 = a3) (b13 : b1 = b3) :
  r (a1 + a2) (b1 * b2) = r (a1 + a3) (b3 * b2) :=
by congrm _₂ (_₂ _ _) (_₂ _ _); assumption

example {A B C : Type*} (r : A → B) (s : B → C) (a b : A) (ab : a = b) :
  s (r a) = s (r b) :=
begin
  congrm _₁ (_₁ _),
  exact ab,
end

open tactic

example {A : Type} [has_add A] (a b c d e f : A) (r : A → A → A → A) (s : A → A)
  (bd : b = d) (af : a = f) (bc : b = c) (ae : a = e) :
  r b (a + s b) a = r d (f + s c) e :=
begin
  congrm _₃ _ (_ + (_₁ _)) _,
  exact bd,
  exact af,
  exact bc,
  exact ae,
end

example {A : Type} [has_add A] (a b c d : A) (r : A → A → A) (s : A → A) (bd : b = d) (bc : b = c) :
  r b (a + s b) = r d (a + s c) :=
begin
  congrm _₂ _ (_₂ _ (s _)),  exact bd, exact bc,
/-  any one of these alternatives to the line above proves the goal
  congrm _₂ _ (_₂ _ (_₁ _)), exact bd, exact bc,
  congrm _₂ _ (_ + (_₁ _)),  exact bd, exact bc,
  congrm _₂ _ (_ + (s _)),   exact bd, exact bc,
  congrm r _ (_₂ _ (s _)),   exact bd, exact bc,
  congrm r _ (_₂ _ (_₁ _)),  exact bd, exact bc,
  congrm r _ (_ + (s _)),    exact bd, exact bc,
  congrm r _ (_ + (_₁ _)),   exact bd, exact bc,
-/
end

example {W X Y Z : Type*} (w w' : W) (y y' : Y) (r : X → Y → Z) (s : W → X)
  (hw : w = w') (hy : y = y') :
  r (s w) y = r (s w') y' :=
by congrm _₂ (_₁ _) _; assumption

example {W X Y : Type*} (w w' : W) (y y' : Y) (r : X → Y → ℕ) (s : W → X)
  (hw : w = w') (hy : y = y') :
  (2 + 2) + r (s w) y = 2 * 2 + r (s w') y' :=
by congrm _₂ (_₂ _ _) (_₂ (_₁ _) _); assumption

example (h1 : 5 = 1) (h2 : 7 = 3) : nat.succ 5 + nat.pred 7 = nat.pred 3 * nat.succ 1 :=
begin
  congrm _₂ (_₁ _) (_₁ _);
 -- the main goal becomes `3.succ + 1.pred = 3.pred * 1.succ` and `refl` closes it!
  exact h1 <|> exact h2,
end

example {a b c d e f g h : ℕ} (ae : a = e) (bf : b = f) (cg : c = g)  (dh : d = h) :
  (a + b) * (c - d.succ) = (e + f) * (g - h.succ) :=
by congrm _₂ (_₂ _ _) (_₂ _ (_₁ _)); assumption


import tactic.interactive
universe zfc_u
variables {α β : Type zfc_u}

-- ideas around the concept of α being canonically isomorphic to β

namespace zfc

-- mod of equiv so I can save typing
structure equiv' (α : Type zfc_u) (β : Type zfc_u) :=
(i    : α → β)
(j    : β → α)
(ij : ∀ (x : α), j (i x) = x)
(ji  : ∀ (y : β), i (j y) = y)

-- it's equiv to equiv, it is absolutely fundamental for the notion of canonical isomorphism, and I like
-- the notation better because it gets everywhere.

--#print has_mul
--@[class]
--structure has_mul : Type u → Type u
--fields:
--has_mul.mul : Π {α : Type u} [c : has_mul α], α → α → α

-- Fundamental theorem of has_mul

definition mul_is_add {α : Type zfc_u} : equiv' (has_mul α) (has_add α) :=
{ i := λ ⟨mul⟩,⟨mul⟩,
  j := λ ⟨mul⟩,⟨mul⟩,
  ij := λ ⟨x⟩,rfl,
  ji := λ ⟨x⟩, rfl,
}

definition equiv_mul {α β : Type zfc_u} : equiv' α β → equiv' (has_mul α) (has_mul β) := λ E,
{ i :=  λ αmul,⟨λ b1 b2, E.i (@has_mul.mul α αmul (E.j b1) (E.j b2))⟩,
  j := λ βmul,⟨λ a1 a2, E.j (@has_mul.mul β βmul (E.i a1) (E.i a2))⟩, -- didn't I just write that?
                                                                      -- should we introduce E-dual?
  ij := λ f, begin
    cases f, -- aargh why do I struggle
    suffices :  (λ (a1 a2 : α), E.j (E.i (f (E.j (E.i a1)) (E.j (E.i a2))))) = (λ a1 a2, f a1 a2),
      by rw this,
    funext,
    simp [E.ij,E.ji], -- got there in the end
  end,
  ji := -- term mode (because i'm a year older)
 λ ⟨g⟩, by simp [E.ij,E.ji]
}

end zfc


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration
import measure_theory.set_integral
import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.core
import formal_ml.measurable_space
import formal_ml.semiring
import formal_ml.real_measurable_space
import formal_ml.set
import formal_ml.filter_util
import topology.instances.ennreal
import formal_ml.int
import formal_ml.with_density_compose_eq_multiply
import formal_ml.classical

lemma with_density_le_with_density {Ω:Type*} {M:measurable_space Ω}
  {μ:measure_theory.measure Ω} {x y:Ω → ennreal}
  {S:set Ω}:
  measurable_set S →
  (∀ ω ∈ S, x ω ≤ y ω) →
  μ.with_density x S ≤ μ.with_density y S :=
begin
  intros A3 A4,
  rw measure_theory.with_density_apply2' μ x S A3,
  rw measure_theory.with_density_apply2' μ y S A3,
  apply measure_theory.lintegral_mono,

  rw le_func_def2,
  intros ω,
  cases (classical.em (ω ∈ S)) with A5 A5,
  {
    rw set.indicator_of_mem A5,
    rw set.indicator_of_mem A5,
    apply A4 _ A5,
  },
  {
    rw set.indicator_of_not_mem A5,
    rw set.indicator_of_not_mem A5,
    apply le_refl _,
  },
end

--TODO: Remove measurability?
lemma with_density_sup_of_le {Ω:Type*} {M:measurable_space Ω}
  {μ:measure_theory.measure Ω} {x y:Ω → ennreal}
  {S:set Ω}:measurable x → measurable y →
  measurable_set S →
  (∀ ω ∈ S, x ω ≤ y ω) →
  μ.with_density (x⊔y) S = μ.with_density y S :=
begin
  intros A1 A2 A3 A4,
  rw measure_theory.with_density_apply2' μ (x ⊔ y) S A3,
  rw measure_theory.with_density_apply2' μ y S A3,
  have A5:set.indicator S (x ⊔ y) = set.indicator S y,
  {
    apply funext,
    intro ω,
    cases (classical.em (ω∈ S)) with A5A A5A,
    {
      rw set.indicator_of_mem A5A,
      rw set.indicator_of_mem A5A,
      rw sup_apply,
      simp [A4 _ A5A],
    },
    {
      rw set.indicator_of_not_mem A5A,
      rw set.indicator_of_not_mem A5A,
    },
  },
  rw A5,
end

lemma measure_theory.measure.sup_le_apply {Ω:Type*}
  {M:measurable_space Ω}
  {μ ν m:measure_theory.measure Ω}
  {S:set Ω}:measurable_set S →
  (μ ≤ m) →
  (ν ≤ m) →
  (μ ⊔ ν) S ≤ m S :=
begin
  intros A1 A2 A3,
  have A4:μ ⊔ ν ≤ m :=
      @sup_le (measure_theory.measure Ω) _ μ ν m A2 A3,
  apply A4,
  apply A1,
end