-- Some results about exp that should probably go to mathlib:
-- analysis/special_functions/exp_log.lean

import data.real.basic
import data.complex.exponential
import analysis.complex.basic
import analysis.special_functions.exp_log
import analysis.calculus.times_cont_diff

noncomputable theory

open real classical topological_space

-- #check continuous_at.add
-- #print filter.tendsto
-- #print nhds
-- #print filter.principal
-- #check fin.sum_univ_zero
-- #check continuous_equiv_fun_basis
-- #check continuous.lim_eq
-- #print continuous_iff_is_closed
-- #print continuous_pi
-- #print Pi.uniform_continuous_proj
-- #check continuous_apply
-- #check exp_sum
-- #check exp_list_sum
-- #check continuous_exp
-- #check exp_nat_mul
-- #eval (2 : ℝ) ^ (3 : ℝ) -- fails, no has_pow ℝ ℝ ...
#check filter.mem_sets_of_superset
#print complex.abs_exp_sub_one_sub_id_le

-- No need!
lemma has_deriv_at_exp_mul (a : ℂ) (x : ℂ) :
has_deriv_at (λ y, complex.exp (a * y)) (a * (complex.exp (a * x))) x :=
begin
	rw has_deriv_at_iff_is_o_nhds_zero,
	have : (1 : ℕ) < 2 := by norm_num,
	refine (asymptotics.is_O.of_bound (∥α * (exp (α * x))∥) _).trans_is_o (asymptotics.is_o_pow_id this),
	-- This should be 1/α and we should assume α > 0.
	have : metric.ball (0 : ℝ) 1 ∈ nhds (0 : ℝ) := metric.ball_mem_nhds 0 zero_lt_one,
	apply filter.mem_sets_of_superset this (λz hz, _),
	simp only [metric.mem_ball, dist_zero_right] at hz,
	simp only [exp_zero, mul_one, one_mul, add_comm, normed_field.norm_pow, zero_add, set.mem_set_of_eq],
	calc ∥exp (α * (x + z)) - exp (α * x) - z * (α * exp (α * x))∥
				= ∥exp (α * x + α * z) - exp (α * x) - z * (α * exp (α * x))∥ : by rw [mul_add]
		... = ∥exp (α * x) * exp (α * z) - exp (α * x) - z * (α * exp (α * x))∥ : by rw [exp_add]
		... = ∥exp (α * x) * exp (α * z) - exp (α * x) - α * (exp (α * x) * z)∥ : by rw [mul_comm z, mul_assoc α]
		... = ∥exp (α * x) * exp (α * z) - exp (α * x) - exp (α * x) * (z * α)∥ : by rw [mul_comm α (_ * _), mul_assoc _ z α]
		... = ∥exp (α * x) * (exp (α * z) - 1 - (z * α))∥ : by ring
		... ≤ ∥α * exp (α * x)∥ * ∥z∥ ^ 2 : by sorry,
	--calc ∥exp (x + z) - exp x - z * exp x∥
	--  = ∥exp x * (exp z - 1 - z)∥ : by { congr, rw [exp_add], ring }
	--  ... = ∥exp x∥ * ∥exp z - 1 - z∥ : normed_field.norm_mul _ _
	--  ... ≤ ∥exp x∥ * ∥z∥^2 :
	--    mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le (le_of_lt hz)) (norm_nonneg _)
end


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

Pi instances for algebraic structures.
-/

import algebra.module order.basic tactic.pi_instances algebra.group

namespace pi
universes u v
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equiped with instances
variables (x y : Π i, f i) (i : I)

instance has_zero [∀ i, has_zero $ f i] : has_zero (Π i : I, f i) := ⟨λ i, 0⟩
@[simp] lemma zero_apply [∀ i, has_zero $ f i] : (0 : Π i, f i) i = 0 := rfl

instance has_one [∀ i, has_one $ f i] : has_one (Π i : I, f i) := ⟨λ i, 1⟩
@[simp] lemma one_apply [∀ i, has_one $ f i] : (1 : Π i, f i) i = 1 := rfl

instance has_add [∀ i, has_add $ f i] : has_add (Π i : I, f i) := ⟨λ x y, λ i, x i + y i⟩
@[simp] lemma add_apply [∀ i, has_add $ f i] : (x + y) i = x i + y i := rfl

instance has_mul [∀ i, has_mul $ f i] : has_mul (Π i : I, f i) := ⟨λ x y, λ i, x i * y i⟩
@[simp] lemma mul_apply [∀ i, has_mul $ f i] : (x * y) i = x i * y i := rfl

instance has_inv [∀ i, has_inv $ f i] : has_inv (Π i : I, f i) := ⟨λ x, λ i, (x i)⁻¹⟩
@[simp] lemma inv_apply [∀ i, has_inv $ f i] : x⁻¹ i = (x i)⁻¹ := rfl

instance has_neg [∀ i, has_neg $ f i] : has_neg (Π i : I, f i) := ⟨λ x, λ i, -(x i)⟩
@[simp] lemma neg_apply [∀ i, has_neg $ f i] : (-x) i = -x i := rfl

instance has_scalar {α : Type*} [∀ i, has_scalar α $ f i] : has_scalar α (Π i : I, f i) := ⟨λ s x, λ i, s • (x i)⟩
@[simp] lemma smul_apply {α : Type*} [∀ i, has_scalar α $ f i] (s : α) : (s • x) i = s • x i := rfl

instance semigroup          [∀ i, semigroup          $ f i] : semigroup          (Π i : I, f i) := by pi_instance
instance comm_semigroup     [∀ i, comm_semigroup     $ f i] : comm_semigroup     (Π i : I, f i) := by pi_instance
instance monoid             [∀ i, monoid             $ f i] : monoid             (Π i : I, f i) := by pi_instance
instance comm_monoid        [∀ i, comm_monoid        $ f i] : comm_monoid        (Π i : I, f i) := by pi_instance
instance group              [∀ i, group              $ f i] : group              (Π i : I, f i) := by pi_instance
instance comm_group         [∀ i, comm_group         $ f i] : comm_group         (Π i : I, f i) := by pi_instance
instance add_semigroup      [∀ i, add_semigroup      $ f i] : add_semigroup      (Π i : I, f i) := by pi_instance
instance add_comm_semigroup [∀ i, add_comm_semigroup $ f i] : add_comm_semigroup (Π i : I, f i) := by pi_instance
instance add_monoid         [∀ i, add_monoid         $ f i] : add_monoid         (Π i : I, f i) := by pi_instance
instance add_comm_monoid    [∀ i, add_comm_monoid    $ f i] : add_comm_monoid    (Π i : I, f i) := by pi_instance
instance add_group          [∀ i, add_group          $ f i] : add_group          (Π i : I, f i) := by pi_instance
instance add_comm_group     [∀ i, add_comm_group     $ f i] : add_comm_group     (Π i : I, f i) := by pi_instance
instance ring               [∀ i, ring               $ f i] : ring               (Π i : I, f i) := by pi_instance
instance comm_ring          [∀ i, comm_ring          $ f i] : comm_ring          (Π i : I, f i) := by pi_instance

instance semimodule   (α) {r : semiring α} [∀ i, semimodule α $ f i]   : semimodule α (Π i : I, f i)   := by pi_instance
instance module       (α) {r : ring α}     [∀ i, module α $ f i]       : module α (Π i : I, f i)       := {..pi.semimodule α}
instance vector_space (α) {r : field α}    [∀ i, vector_space α $ f i] : vector_space α (Π i : I, f i) := {..pi.module α}

instance left_cancel_semigroup [∀ i, left_cancel_semigroup $ f i] : left_cancel_semigroup (Π i : I, f i) :=
by pi_instance

instance add_left_cancel_semigroup [∀ i, add_left_cancel_semigroup $ f i] : add_left_cancel_semigroup (Π i : I, f i) :=
by pi_instance

instance right_cancel_semigroup [∀ i, right_cancel_semigroup $ f i] : right_cancel_semigroup (Π i : I, f i) :=
by pi_instance

instance add_right_cancel_semigroup [∀ i, add_right_cancel_semigroup $ f i] : add_right_cancel_semigroup (Π i : I, f i) :=
by pi_instance

instance ordered_cancel_comm_monoid [∀ i, ordered_cancel_comm_monoid $ f i] : ordered_cancel_comm_monoid (Π i : I, f i) :=
by pi_instance

end pi

namespace prod
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {p q : α × β}

instance [has_add α] [has_add β] : has_add (α × β) :=
⟨λp q, (p.1 + q.1, p.2 + q.2)⟩

@[to_additive prod.has_add]
instance [has_mul α] [has_mul β] : has_mul (α × β) :=
⟨λp q, (p.1 * q.1, p.2 * q.2)⟩

@[simp, to_additive prod.fst_add]
lemma fst_mul [has_mul α] [has_mul β] : (p * q).1 = p.1 * q.1 := rfl
@[simp, to_additive prod.snd_add]
lemma snd_mul [has_mul α] [has_mul β] : (p * q).2 = p.2 * q.2 := rfl

instance [has_zero α] [has_zero β] : has_zero (α × β) := ⟨(0, 0)⟩

@[to_additive prod.has_zero]
instance [has_one α] [has_one β] : has_one (α × β) := ⟨(1, 1)⟩

@[simp, to_additive prod.fst_zero]
lemma fst_one [has_one α] [has_one β] : (1 : α × β).1 = 1 := rfl
@[simp, to_additive prod.snd_zero]
lemma snd_one [has_one α] [has_one β] : (1 : α × β).2 = 1 := rfl

instance [has_neg α] [has_neg β] : has_neg (α × β) := ⟨λp, (- p.1, - p.2)⟩

@[to_additive prod.has_neg]
instance [has_inv α] [has_inv β] : has_inv (α × β) := ⟨λp, (p.1⁻¹, p.2⁻¹)⟩

@[simp, to_additive prod.fst_neg]
lemma fst_inv [has_inv α] [has_inv β] : (p⁻¹).1 = (p.1)⁻¹ := rfl
@[simp, to_additive prod.snd_neg]
lemma snd_inv [has_inv α] [has_inv β] : (p⁻¹).2 = (p.2)⁻¹ := rfl

instance [add_semigroup α] [add_semigroup β] : add_semigroup (α × β) :=
{ add_assoc := assume a b c, mk.inj_iff.mpr ⟨add_assoc _ _ _, add_assoc _ _ _⟩,
  .. prod.has_add }
@[to_additive prod.add_semigroup]
instance [semigroup α] [semigroup β] : semigroup (α × β) :=
{ mul_assoc := assume a b c, mk.inj_iff.mpr ⟨mul_assoc _ _ _, mul_assoc _ _ _⟩,
  .. prod.has_mul }

instance [add_monoid α] [add_monoid β] : add_monoid (α × β) :=
{ zero_add := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨zero_add _, zero_add _⟩,
  add_zero := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨add_zero _, add_zero _⟩,
  .. prod.add_semigroup, .. prod.has_zero }
@[to_additive prod.add_monoid]
instance [monoid α] [monoid β] : monoid (α × β) :=
{ one_mul := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨one_mul _, one_mul _⟩,
  mul_one := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨mul_one _, mul_one _⟩,
  .. prod.semigroup, .. prod.has_one }

instance [add_group α] [add_group β] : add_group (α × β) :=
{ add_left_neg := assume a, mk.inj_iff.mpr ⟨add_left_neg _, add_left_neg _⟩,
  .. prod.add_monoid, .. prod.has_neg }
@[to_additive prod.add_group]
instance [group α] [group β] : group (α × β) :=
{ mul_left_inv := assume a, mk.inj_iff.mpr ⟨mul_left_inv _, mul_left_inv _⟩,
  .. prod.monoid, .. prod.has_inv }

instance [add_comm_semigroup α] [add_comm_semigroup β] : add_comm_semigroup (α × β) :=
{ add_comm := assume a b, mk.inj_iff.mpr ⟨add_comm _ _, add_comm _ _⟩,
  .. prod.add_semigroup }
@[to_additive prod.add_comm_semigroup]
instance [comm_semigroup α] [comm_semigroup β] : comm_semigroup (α × β) :=
{ mul_comm := assume a b, mk.inj_iff.mpr ⟨mul_comm _ _, mul_comm _ _⟩,
  .. prod.semigroup }

instance [add_comm_monoid α] [add_comm_monoid β] : add_comm_monoid (α × β) :=
{ .. prod.add_comm_semigroup, .. prod.add_monoid }
@[to_additive prod.add_comm_monoid]
instance [comm_monoid α] [comm_monoid β] : comm_monoid (α × β) :=
{ .. prod.comm_semigroup, .. prod.monoid }

instance [add_comm_group α] [add_comm_group β] : add_comm_group (α × β) :=
{ .. prod.add_comm_semigroup, .. prod.add_group }
@[to_additive prod.add_comm_group]
instance [comm_group α] [comm_group β] : comm_group (α × β) :=
{ .. prod.comm_semigroup, .. prod.group }

@[to_additive prod.fst_sum]
lemma fst_prod [comm_monoid α] [comm_monoid β] {t : finset γ} {f : γ → α × β} :
  (t.prod f).1 = t.prod (λc, (f c).1) :=
(finset.prod_hom prod.fst (show (1:α×β).1 = 1, from rfl) $ assume x y, rfl).symm

@[to_additive prod.snd_sum]
lemma snd_prod [comm_monoid α] [comm_monoid β] {t : finset γ} {f : γ → α × β} :
  (t.prod f).2 = t.prod (λc, (f c).2) :=
(finset.prod_hom prod.snd (show (1:α×β).2 = 1, from rfl) $ assume x y, rfl).symm

instance [semiring α] [semiring β] : semiring (α × β) :=
{ zero_mul := λ a, mk.inj_iff.mpr ⟨zero_mul _, zero_mul _⟩,
  mul_zero := λ a, mk.inj_iff.mpr ⟨mul_zero _, mul_zero _⟩,
  left_distrib := λ a b c, mk.inj_iff.mpr ⟨left_distrib _ _ _, left_distrib _ _ _⟩,
  right_distrib := λ a b c, mk.inj_iff.mpr ⟨right_distrib _ _ _, right_distrib _ _ _⟩,
  ..prod.add_comm_monoid, ..prod.monoid }

instance [ring α] [ring β] : ring (α × β) :=
{ ..prod.add_comm_group, ..prod.semiring }

instance [comm_ring α] [comm_ring β] : comm_ring (α × β) :=
{ ..prod.ring, ..prod.comm_monoid }

instance [nonzero_comm_ring α] [comm_ring β] : nonzero_comm_ring (α × β) :=
{ zero_ne_one := mt (congr_arg prod.fst) zero_ne_one,
  ..prod.comm_ring }

/-- Left injection function for the inner product
From a vector space (and also group and module) perspective the product is the same as the sum of
two vector spaces. `inl` and `inr` provide the corresponding injection functions.
-/
def inl [has_zero β] (a : α) : α × β := (a, 0)

/-- Right injection function for the inner product -/
def inr [has_zero α] (b : β) : α × β := (0, b)

lemma injective_inl [has_zero β] : function.injective (inl : α → α × β) :=
assume x y h, (prod.mk.inj_iff.mp h).1

lemma injective_inr [has_zero α] : function.injective (inr : β → α × β) :=
assume x y h, (prod.mk.inj_iff.mp h).2

@[simp] lemma inl_eq_inl [has_zero β] {a₁ a₂ : α} : (inl a₁ : α × β) = inl a₂ ↔ a₁ = a₂ :=
iff.intro (assume h, injective_inl h) (assume h, h ▸ rfl)

@[simp] lemma inr_eq_inr [has_zero α] {b₁ b₂ : β} : (inr b₁ : α × β) = inr b₂ ↔ b₁ = b₂ :=
iff.intro (assume h, injective_inr h) (assume h, h ▸ rfl)

@[simp] lemma inl_eq_inr [has_zero α] [has_zero β] {a : α} {b : β} :
  inl a = inr b ↔ a = 0 ∧ b = 0 :=
by constructor; simp [inl, inr] {contextual := tt}

@[simp] lemma inr_eq_inl [has_zero α] [has_zero β] {a : α} {b : β} :
  inr b = inl a ↔ a = 0 ∧ b = 0 :=
by constructor; simp [inl, inr] {contextual := tt}

@[simp] lemma fst_inl [has_zero β] (a : α) : (inl a : α × β).1 = a := rfl
@[simp] lemma snd_inl [has_zero β] (a : α) : (inl a : α × β).2 = 0 := rfl
@[simp] lemma fst_inr [has_zero α] (b : β) : (inr b : α × β).1 = 0 := rfl
@[simp] lemma snd_inr [has_zero α] (b : β) : (inr b : α × β).2 = b := rfl

instance [has_scalar α β] [has_scalar α γ] : has_scalar α (β × γ) := ⟨λa p, (a • p.1, a • p.2)⟩

instance {r : ring α} [module α β] [module α γ] : module α (β × γ) :=
{ smul_add  := assume a p₁ p₂, mk.inj_iff.mpr ⟨smul_add, smul_add⟩,
  add_smul  := assume a p₁ p₂, mk.inj_iff.mpr ⟨add_smul, add_smul⟩,
  mul_smul  := assume a₁ a₂ p, mk.inj_iff.mpr ⟨mul_smul, mul_smul⟩,
  one_smul  := assume ⟨b, c⟩, mk.inj_iff.mpr ⟨one_smul, one_smul⟩,
  .. prod.has_scalar }

instance {r : field α} [vector_space α β] [vector_space α γ] : vector_space α (β × γ) := {}

end prod


import algebra.category.Group.abelian
import enough_injectives.adjunction_transfer_enough_injective
import enough_injectives.divisible_group
import algebra.category.Ring

section

universes v
variables (R : Ring.{v})

open tensor_product
open category_theory
open_locale tensor_product

namespace coextension

variable (A : Ab.{v})

instance : module R ((⟨R⟩ : Ab) ⟶ A) :=
{ smul := λ r f,
  { to_fun := λ r', f (r' * r),
    map_zero' := by rw [zero_mul, map_zero],
    map_add' := λ a b, by rw [add_mul, map_add] },
  one_smul := λ f, begin
    ext1 r,
    change f _ = _,
    rw [mul_one],
  end,
  mul_smul := λ r1 r2 f, begin
    ext1 r,
    change f _ = f _,
    rw mul_assoc,
  end,
  smul_add := λ r f g, begin
    ext1 x,
    change (f + g) _ = f _ + g _,
    refl,
  end,
  smul_zero := λ r, begin
    ext1 x,
    change (0 : (⟨R⟩ : Ab) ⟶ A) _ = _,
    refl,
  end,
  add_smul := λ r s f, begin
    ext1 x,
    change f _ = f _ + f _,
    rw [mul_add, map_add],
  end,
  zero_smul := λ f, begin
    ext1 x,
    change f _ = _,
    rw [mul_zero, map_zero, add_monoid_hom.zero_apply],
  end }

@[simp] lemma smul_apply (r : R) (f : (⟨R⟩ : Ab) ⟶ A) (x : R) :
  (r • f) x = f (x * r) := rfl

def map {B C : Ab.{v}} (f : B ⟶ C) :
  (⟨(⟨R⟩ : Ab) ⟶ B⟩ : Module R) ⟶ ⟨(⟨R⟩ : Ab) ⟶ C⟩ :=
{ to_fun := λ g,
  { to_fun := λ r, f (g r),
    map_zero' := by rw [map_zero, map_zero],
    map_add' := λ x y, by rw [map_add, map_add] },
  map_add' := λ g1 g2, by ext; simp,
  map_smul' := λ r g, by ext; simp }

@[simp] lemma map_apply {B C : Ab.{v}} (f : B ⟶ C)
  (g : (⟨R⟩ : Ab) ⟶ B) (x : R) :
  map R f g x = f (g x) := rfl

@[simps]
def functor : Ab.{v} ⥤ Module.{v} R :=
{ obj := λ A, ⟨(⟨R⟩ : Ab) ⟶ A⟩,
  map := λ X Y g, map R g,
  map_id' := λ X, begin
    ext f x,
    simp only [Module.id_apply, map_apply, id_apply],
  end,
  map_comp' := λ X Y Z g1 g2, begin
    ext f x,
    simp only [map_apply, comp_apply],
  end }

end coextension

namespace adj

variables (M : Module.{v} R) (A : Ab.{v})

namespace hom_equiv

def forward (f : (forget₂ (Module.{v} R) Ab.{v}).obj M ⟶ A) :
  M ⟶ (coextension.functor R).obj A :=
{ to_fun := λ m,
  { to_fun := λ r, f (@has_scalar.smul R M _ r m),
    map_zero' := by rw [zero_smul, map_zero],
    map_add' := λ x y, by rw [add_smul, map_add] },
  map_add' := λ x y, begin
    ext1 z,
    simp only [map_add, smul_add, add_monoid_hom.coe_mk, add_monoid_hom.add_apply],
  end,
  map_smul' := λ r x, begin
    ext1 z,
    simp only [add_monoid_hom.coe_mk, ring_hom.id_apply, coextension.smul_apply],
    rw [mul_smul],
  end }

def backward (f : M ⟶ (coextension.functor R).obj A) :
  (forget₂ (Module.{v} R) Ab.{v}).obj M ⟶ A :=
{ to_fun := λ m, (f m).to_fun 1,
  map_zero' := by simp,
  map_add' := λ x y, by simp }

lemma fb (f : (forget₂ (Module.{v} R) Ab.{v}).obj M ⟶ A) :
  backward R M A (forward R M A f) = f :=
by ext; simp [backward, forward]

lemma bf (f : M ⟶ (coextension.functor R).obj A) :
  forward R M A (backward R M A f) = f :=
by ext; simp [backward, forward]

end hom_equiv

@[simps]
def unit :
  𝟭 (Module R) ⟶
  forget₂ (Module ↥R) Ab ⋙ coextension.functor R :=
{ app := λ M,
  { to_fun := λ m,
    { to_fun := λ r, @has_scalar.smul R M _ r m,
      map_zero' := by rw [zero_smul],
      map_add' := λ x y, by rw [add_smul] },
    map_add' := λ x y, begin
      ext1 z,
      simp only [smul_add, add_monoid_hom.coe_mk, add_monoid_hom.add_apply],
    end,
    map_smul' := λ r m, begin
      ext1 z,
      simp only [mul_smul, add_monoid_hom.coe_mk, ring_hom.id_apply, coextension.smul_apply],
    end },
  naturality' := λ X Y f, begin
    ext r r',
    simp only [add_monoid_hom.coe_mk, ring_hom.id_apply, functor.id_map, Module.coe_comp, linear_map.coe_mk, functor.comp_map,
      Module.forget₂_map, coextension.functor_map, coextension.map_apply, linear_map.to_add_monoid_hom_coe,
      linear_map.map_smulₛₗ],
  end }

@[simps]
def counit : (coextension.functor R ⋙ forget₂ (Module.{v} R) Ab.{v}) ⟶ 𝟭 Ab :=
{ app := λ A,
  { to_fun := λ f, f.to_fun 1,
    map_zero' := rfl,
    map_add' := λ x y, by simp only [add_monoid_hom.to_fun_eq_coe, add_monoid_hom.add_apply] },
  naturality' := λ X Y g, begin
    ext,
    simp only [add_monoid_hom.to_fun_eq_coe, functor.comp_map, coextension.functor_map, Module.forget₂_map, comp_apply,
      linear_map.to_add_monoid_hom_coe, add_monoid_hom.coe_mk, coextension.map_apply, functor.id_map],
  end }

end adj

instance left_adj  : is_left_adjoint (forget₂ (Module.{v} R) Ab.{v}) :=
{ right := coextension.functor R,
  adj :=
  { hom_equiv := λ X Y,
    { to_fun := adj.hom_equiv.forward R X Y,
      inv_fun := adj.hom_equiv.backward R X Y,
      left_inv := adj.hom_equiv.fb R X Y,
      right_inv := adj.hom_equiv.bf R X Y },
    unit := adj.unit R,
    counit := adj.counit R,
    hom_equiv_unit' := λ M A f, begin
      ext m r,
      simp only [adj.hom_equiv.forward, equiv.coe_fn_mk, linear_map.coe_mk, add_monoid_hom.coe_mk, coextension.functor_map,
        Module.coe_comp, coextension.map_apply, adj.unit_app_apply_apply],
    end,
    hom_equiv_counit' := λ M A f, begin
      ext,
      simp only [adj.hom_equiv.backward, equiv.coe_fn_symm_mk, add_monoid_hom.coe_mk, Module.forget₂_map, comp_apply,
        linear_map.to_add_monoid_hom_coe, adj.counit_app_apply],
    end } }

instance : category_theory.enough_injectives (Module.{v} R) :=
have h : _ := (category_theory.adjunction.left_adjoint_preserves_colimits (left_adj R).adj).1,
@@category_theory.enough_injectives.of_adjunction _ _ _ _ _ _ _  ⟨λ J i1 i2, @h J i1⟩ (left_adj R).adj

end


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.normed_space.lp_space
import topology.sets.compacts

/-!
# The Kuratowski embedding

Any separable metric space can be embedded isometrically in `ℓ^∞(ℝ)`.
-/

noncomputable theory

open set metric topological_space
open_locale ennreal
local notation `ℓ_infty_ℝ`:= lp (λ n : ℕ, ℝ) ∞

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

namespace Kuratowski_embedding

/-! ### Any separable metric space can be embedded isometrically in ℓ^∞(ℝ) -/

variables {f g : ℓ_infty_ℝ} {n : ℕ} {C : ℝ} [metric_space α] (x : ℕ → α) (a b : α)

/-- A metric space can be embedded in `l^∞(ℝ)` via the distances to points in
a fixed countable set, if this set is dense. This map is given in `Kuratowski_embedding`,
without density assumptions. -/
def embedding_of_subset : ℓ_infty_ℝ :=
⟨ λ n, dist a (x n) - dist (x 0) (x n),
  begin
    apply mem_ℓp_infty,
    use dist a (x 0),
    rintros - ⟨n, rfl⟩,
    exact abs_dist_sub_le _ _ _
  end ⟩

lemma embedding_of_subset_coe : embedding_of_subset x a n = dist a (x n) - dist (x 0) (x n) := rfl

/-- The embedding map is always a semi-contraction. -/
lemma embedding_of_subset_dist_le (a b : α) :
  dist (embedding_of_subset x a) (embedding_of_subset x b) ≤ dist a b :=
begin
  refine lp.norm_le_of_forall_le dist_nonneg (λn, _),
  simp only [lp.coe_fn_sub, pi.sub_apply, embedding_of_subset_coe, real.dist_eq],
  convert abs_dist_sub_le a b (x n) using 2,
  ring
end

/-- When the reference set is dense, the embedding map is an isometry on its image. -/
lemma embedding_of_subset_isometry (H : dense_range x) : isometry (embedding_of_subset x) :=
begin
  refine isometry_emetric_iff_metric.2 (λa b, _),
  refine (embedding_of_subset_dist_le x a b).antisymm (le_of_forall_pos_le_add (λe epos, _)),
  /- First step: find n with dist a (x n) < e -/
  rcases metric.mem_closure_range_iff.1 (H a) (e/2) (half_pos epos) with ⟨n, hn⟩,
  /- Second step: use the norm control at index n to conclude -/
  have C : dist b (x n) - dist a (x n) = embedding_of_subset x b n - embedding_of_subset x a n :=
    by { simp only [embedding_of_subset_coe, sub_sub_sub_cancel_right] },
  have := calc
    dist a b ≤ dist a (x n) + dist (x n) b : dist_triangle _ _ _
    ...    = 2 * dist a (x n) + (dist b (x n) - dist a (x n)) : by { simp [dist_comm], ring }
    ...    ≤ 2 * dist a (x n) + |dist b (x n) - dist a (x n)| :
      by apply_rules [add_le_add_left, le_abs_self]
    ...    ≤ 2 * (e/2) + |embedding_of_subset x b n - embedding_of_subset x a n| :
      begin rw C, apply_rules [add_le_add, mul_le_mul_of_nonneg_left, hn.le, le_refl], norm_num end
    ...    ≤ 2 * (e/2) + dist (embedding_of_subset x b) (embedding_of_subset x a) :
    begin
      have : |embedding_of_subset x b n - embedding_of_subset x a n|
        ≤ dist (embedding_of_subset x b) (embedding_of_subset x a),
      { simpa [dist_eq_norm] using lp.norm_apply_le_norm ennreal.top_ne_zero
          (embedding_of_subset x b - embedding_of_subset x a) n },
      nlinarith,
    end
    ...    = dist (embedding_of_subset x b) (embedding_of_subset x a) + e : by ring,
  simpa [dist_comm] using this
end

/-- Every separable metric space embeds isometrically in `ℓ_infty_ℝ`. -/
theorem exists_isometric_embedding (α : Type u) [metric_space α] [separable_space α] :
  ∃(f : α → ℓ_infty_ℝ), isometry f :=
begin
  cases (univ : set α).eq_empty_or_nonempty with h h,
  { use (λ_, 0), assume x, exact absurd h (nonempty.ne_empty ⟨x, mem_univ x⟩) },
  { /- We construct a map x : ℕ → α with dense image -/
    rcases h with ⟨basepoint⟩,
    haveI : inhabited α := ⟨basepoint⟩,
    have : ∃s:set α, countable s ∧ dense s := exists_countable_dense α,
    rcases this with ⟨S, ⟨S_countable, S_dense⟩⟩,
    rcases countable_iff_exists_surjective.1 S_countable with ⟨x, x_range⟩,
    /- Use embedding_of_subset to construct the desired isometry -/
    exact ⟨embedding_of_subset x, embedding_of_subset_isometry x (S_dense.mono x_range)⟩ }
end
end Kuratowski_embedding

open topological_space Kuratowski_embedding

/-- The Kuratowski embedding is an isometric embedding of a separable metric space in `ℓ^∞(ℝ)`. -/
def Kuratowski_embedding (α : Type u) [metric_space α] [separable_space α] : α → ℓ_infty_ℝ :=
  classical.some (Kuratowski_embedding.exists_isometric_embedding α)

/-- The Kuratowski embedding is an isometry. -/
protected lemma Kuratowski_embedding.isometry (α : Type u) [metric_space α] [separable_space α] :
  isometry (Kuratowski_embedding α) :=
classical.some_spec (exists_isometric_embedding α)

/-- Version of the Kuratowski embedding for nonempty compacts -/
def nonempty_compacts.Kuratowski_embedding (α : Type u) [metric_space α] [compact_space α]
  [nonempty α] :
  nonempty_compacts ℓ_infty_ℝ :=
{ carrier := range (Kuratowski_embedding α),
  compact' := is_compact_range (Kuratowski_embedding.isometry α).continuous,
  nonempty' := range_nonempty _ }


import data.list.basic

universe u

theorem list.foldl_map' {α β: Type u} (g : α → β) (f : α → α → α) (f' : β → β → β)
  (a : α) (l : list α) (h : ∀ x y, g (f x y) = f' (g x) (g y)) :
  g (list.foldl f a l) = list.foldl f' (g a) (l.map g) :=
begin
  induction l generalizing a,
  { simp },
  { simp [list.foldl_cons, l_ih, h] }
end

lemma function.injective_foldl_comp {α : Type*} {l : list (α → α)} {f : α → α}
  (hl : ∀ f ∈ l, function.injective f) (hf : function.injective f):
  function.injective (@list.foldl (α → α) (α → α) function.comp f l) :=
begin
  induction l generalizing f,
  { exact hf },
  { apply l_ih (λ _ h, hl _ (list.mem_cons_of_mem _ h)),
    apply function.injective_comp hf,
    apply hl _ (list.mem_cons_self _ _) }
end


import data.finset.basic
import data.fintype.basic

namespace subset_subtype

variable {α : Type*}
variable {t : finset α}
variable t' : {s // s ⊆ t}

namespace finset_subtype

def coe : finset ↥t :=
finset.map
  ⟨set.inclusion t'.property, set.inclusion_injective t'.property⟩
  (finset.univ : finset ↥(t'.val))

instance has_coe :
  has_coe ({s // s ⊆ t}) (finset ↥t) := ⟨coe⟩

theorem coe_injective :
function.injective (coe : {s // s ⊆ t} → (finset ↥t)) :=
begin
  unfold function.injective,
  intros s₁ s₂ h,
  unfold coe at h,
  rw subtype.ext_iff,
  rw finset.ext_iff,
  intro x,
  split,
  { intro x_in₁,
    rw finset.ext_iff at h,
    specialize h ⟨x, finset.mem_of_subset s₁.property x_in₁⟩,
    change (⟨x, finset.mem_of_subset s₁.property x_in₁⟩ : ↥t) with
      (⟨set.inclusion s₁.property,
        set.inclusion_injective s₁.property ⟩ : function.embedding _ _)
        ⟨x, x_in₁⟩ at h,
    rw finset.mem_map' at h,
    have x_in₂ := h.mp (finset.mem_univ ⟨x, x_in₁⟩),
    rw finset.mem_map at x_in₂,
    rcases x_in₂ with ⟨x', _, h'⟩,
    change (⟨x'.val, _⟩ : ↥t) = ⟨x, _⟩ at h',
    rw subtype.mk_eq_mk at h',
    have x'_in₂ := x'.property,
    rw h' at x'_in₂,
    exact x'_in₂, },
  { intro x_in₂,
    rw finset.ext_iff at h,
    specialize h ⟨x, finset.mem_of_subset s₂.property x_in₂⟩,
    change (⟨x, finset.mem_of_subset s₂.property x_in₂⟩ : ↥t) with
      (⟨set.inclusion s₂.property,
        set.inclusion_injective s₂.property ⟩ : function.embedding _ _)
        ⟨x, x_in₂⟩ at h,
    rw finset.mem_map' at h,
    have x_in₁ := h.mpr (finset.mem_univ ⟨x, x_in₂⟩),
    rw finset.mem_map at x_in₁,
    rcases x_in₁ with ⟨x', _, h'⟩,
    change (⟨x'.val, _⟩ : ↥t) = ⟨x, _⟩ at h',
    rw subtype.mk_eq_mk at h',
    have x'_in₁ := x'.property,
    rw h' at x'_in₁,
    exact x'_in₁, },
end

end finset_subtype

lemma coe_type : finset.map
  (function.embedding.subtype (∈ t))
  (finset_subtype.coe t') = t'.val :=
begin
  rw finset.ext_iff,
  intro x,
  unfold finset_subtype.coe,
  rw finset.mem_map,
  simp only [ subtype.val_eq_coe, finset.mem_map, finset.mem_univ,
              function.embedding.coe_fn_mk, set_coe.exists,
              function.embedding.coe_subtype, exists_prop, subtype.exists,
              subtype.coe_mk, exists_and_distrib_right, exists_eq_right,
              true_and ],
  split,
  { rintro ⟨x_in_t, x', x'_in_s, h'⟩,
    change (⟨x', _⟩ : ↥t) = ⟨x, _⟩ at h',
    rw subtype.mk_eq_mk at h',
    rw ← h',
    exact x'_in_s, },
  { intro x_in_s,
    use finset.mem_of_subset t'.property x_in_s,
    use x,
    use x_in_s,
    refl, },
end

end subset_subtype


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.measure_theory.measurable_space
import Mathlib.topology.algebra.infinite_sum
import Mathlib.PostPort

universes u_1 l u_2 u_3 u

namespace Mathlib

/-!
# Outer Measures

An outer measure is a function `μ : set α → ennreal`, from the powerset of a type to the extended
nonnegative real numbers that satisfies the following conditions:
1. `μ ∅ = 0`;
2. `μ` is monotone;
3. `μ` is countably subadditive. This means that the outer measure of a countable union is at most
   the sum of the outer measure on the individual sets.

Note that we do not need `α` to be measurable to define an outer measure.

The outer measures on a type `α` form a complete lattice.

Given an arbitrary function `m : set α → ennreal` that sends `∅` to `0` we can define an outer
measure on `α` that on `s` is defined to be the infimum of `∑ᵢ, m (sᵢ)` for all collections of sets
`sᵢ` that cover `s`. This is the unique maximal outer measure that is at most the given function.
We also define this for functions `m` defined on a subset of `set α`, by treating the function as
having value `∞` outside its domain.

Given an outer measure `m`, the Carathéodory-measurable sets are the sets `s` such that
for all sets `t` we have `m t = m (t ∩ s) + m (t \ s)`. This forms a measurable space.

## Main definitions and statements

* `outer_measure.bounded_by` is the greatest outer measure that is at most the given function.
  If you know that the given functions sends `∅` to `0`, then `outer_measure.of_function` is a
  special case.
* `caratheodory` is the Carathéodory-measurable space of an outer measure.
* `Inf_eq_of_function_Inf_gen` is a characterization of the infimum of outer measures.
* `induced_outer_measure` is the measure induced by a function on a subset of `set α`

## References

* <https://en.wikipedia.org/wiki/Outer_measure>
* <https://en.wikipedia.org/wiki/Carath%C3%A9odory%27s_criterion>

## Tags

outer measure, Carathéodory-measurable, Carathéodory's criterion
-/

namespace measure_theory

/-- An outer measure is a countably subadditive monotone function that sends `∅` to `0`. -/
structure outer_measure (α : Type u_1)
where
  measure_of : set α → ennreal
  empty : measure_of ∅ = 0
  mono : ∀ {s₁ s₂ : set α}, s₁ ⊆ s₂ → measure_of s₁ ≤ measure_of s₂
  Union_nat : ∀ (s : ℕ → set α), measure_of (set.Union fun (i : ℕ) => s i) ≤ tsum fun (i : ℕ) => measure_of (s i)

namespace outer_measure

protected instance has_coe_to_fun {α : Type u_1} : has_coe_to_fun (outer_measure α) :=
  has_coe_to_fun.mk (fun (m : outer_measure α) => set α → ennreal) fun (m : outer_measure α) => measure_of m

@[simp] theorem measure_of_eq_coe {α : Type u_1} (m : outer_measure α) : measure_of m = ⇑m :=
  rfl

@[simp] theorem empty' {α : Type u_1} (m : outer_measure α) : coe_fn m ∅ = 0 :=
  empty m

theorem mono' {α : Type u_1} (m : outer_measure α) {s₁ : set α} {s₂ : set α} (h : s₁ ⊆ s₂) : coe_fn m s₁ ≤ coe_fn m s₂ :=
  mono m h

protected theorem Union {α : Type u_1} (m : outer_measure α) {β : Type u_2} [encodable β] (s : β → set α) : coe_fn m (set.Union fun (i : β) => s i) ≤ tsum fun (i : β) => coe_fn m (s i) :=
  rel_supr_tsum (⇑m) (empty m) LessEq (Union_nat m) s

theorem Union_null {α : Type u_1} (m : outer_measure α) {β : Type u_2} [encodable β] {s : β → set α} (h : ∀ (i : β), coe_fn m (s i) = 0) : coe_fn m (set.Union fun (i : β) => s i) = 0 := sorry

protected theorem Union_finset {α : Type u_1} {β : Type u_2} (m : outer_measure α) (s : β → set α) (t : finset β) : coe_fn m (set.Union fun (i : β) => set.Union fun (H : i ∈ t) => s i) ≤ finset.sum t fun (i : β) => coe_fn m (s i) :=
  rel_supr_sum (⇑m) (empty m) LessEq (Union_nat m) s t

protected theorem union {α : Type u_1} (m : outer_measure α) (s₁ : set α) (s₂ : set α) : coe_fn m (s₁ ∪ s₂) ≤ coe_fn m s₁ + coe_fn m s₂ :=
  rel_sup_add (⇑m) (empty m) LessEq (Union_nat m) s₁ s₂

theorem le_inter_add_diff {α : Type u_1} {m : outer_measure α} {t : set α} (s : set α) : coe_fn m t ≤ coe_fn m (t ∩ s) + coe_fn m (t \ s) := sorry

theorem diff_null {α : Type u_1} (m : outer_measure α) (s : set α) {t : set α} (ht : coe_fn m t = 0) : coe_fn m (s \ t) = coe_fn m s := sorry

theorem union_null {α : Type u_1} (m : outer_measure α) {s₁ : set α} {s₂ : set α} (h₁ : coe_fn m s₁ = 0) (h₂ : coe_fn m s₂ = 0) : coe_fn m (s₁ ∪ s₂) = 0 := sorry

theorem injective_coe_fn {α : Type u_1} : function.injective fun (μ : outer_measure α) (s : set α) => coe_fn μ s := sorry

theorem ext {α : Type u_1} {μ₁ : outer_measure α} {μ₂ : outer_measure α} (h : ∀ (s : set α), coe_fn μ₁ s = coe_fn μ₂ s) : μ₁ = μ₂ :=
  injective_coe_fn (funext h)

protected instance has_zero {α : Type u_1} : HasZero (outer_measure α) :=
  { zero := mk (fun (_x : set α) => 0) sorry sorry sorry }

@[simp] theorem coe_zero {α : Type u_1} : ⇑0 = 0 :=
  rfl

protected instance inhabited {α : Type u_1} : Inhabited (outer_measure α) :=
  { default := 0 }

protected instance has_add {α : Type u_1} : Add (outer_measure α) :=
  { add := fun (m₁ m₂ : outer_measure α) => mk (fun (s : set α) => coe_fn m₁ s + coe_fn m₂ s) sorry sorry sorry }

@[simp] theorem coe_add {α : Type u_1} (m₁ : outer_measure α) (m₂ : outer_measure α) : ⇑(m₁ + m₂) = ⇑m₁ + ⇑m₂ :=
  rfl

theorem add_apply {α : Type u_1} (m₁ : outer_measure α) (m₂ : outer_measure α) (s : set α) : coe_fn (m₁ + m₂) s = coe_fn m₁ s + coe_fn m₂ s :=
  rfl

protected instance add_comm_monoid {α : Type u_1} : add_comm_monoid (outer_measure α) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance has_scalar {α : Type u_1} : has_scalar ennreal (outer_measure α) :=
  has_scalar.mk fun (c : ennreal) (m : outer_measure α) => mk (fun (s : set α) => c * coe_fn m s) sorry sorry sorry

@[simp] theorem coe_smul {α : Type u_1} (c : ennreal) (m : outer_measure α) : ⇑(c • m) = c • ⇑m :=
  rfl

theorem smul_apply {α : Type u_1} (c : ennreal) (m : outer_measure α) (s : set α) : coe_fn (c • m) s = c * coe_fn m s :=
  rfl

protected instance semimodule {α : Type u_1} : semimodule ennreal (outer_measure α) :=
  semimodule.mk sorry sorry

protected instance has_bot {α : Type u_1} : has_bot (outer_measure α) :=
  has_bot.mk 0

protected instance outer_measure.order_bot {α : Type u_1} : order_bot (outer_measure α) :=
  order_bot.mk 0 (fun (m₁ m₂ : outer_measure α) => ∀ (s : set α), coe_fn m₁ s ≤ coe_fn m₂ s)
    (partial_order.lt._default fun (m₁ m₂ : outer_measure α) => ∀ (s : set α), coe_fn m₁ s ≤ coe_fn m₂ s) sorry sorry
    sorry sorry

protected instance has_Sup {α : Type u_1} : has_Sup (outer_measure α) :=
  has_Sup.mk
    fun (ms : set (outer_measure α)) =>
      mk (fun (s : set α) => supr fun (m : outer_measure α) => supr fun (H : m ∈ ms) => coe_fn m s) sorry sorry sorry

protected instance complete_lattice {α : Type u_1} : complete_lattice (outer_measure α) :=
  complete_lattice.mk complete_lattice.sup order_bot.le order_bot.lt sorry sorry sorry sorry sorry sorry
    complete_lattice.inf sorry sorry sorry complete_lattice.top sorry order_bot.bot sorry complete_lattice.Sup
    complete_lattice.Inf sorry sorry sorry sorry

@[simp] theorem Sup_apply {α : Type u_1} (ms : set (outer_measure α)) (s : set α) : coe_fn (Sup ms) s = supr fun (m : outer_measure α) => supr fun (H : m ∈ ms) => coe_fn m s :=
  rfl

@[simp] theorem supr_apply {α : Type u_1} {ι : Sort u_2} (f : ι → outer_measure α) (s : set α) : coe_fn (supr fun (i : ι) => f i) s = supr fun (i : ι) => coe_fn (f i) s := sorry

theorem coe_supr {α : Type u_1} {ι : Sort u_2} (f : ι → outer_measure α) : ⇑(supr fun (i : ι) => f i) = supr fun (i : ι) => ⇑(f i) := sorry

@[simp] theorem sup_apply {α : Type u_1} (m₁ : outer_measure α) (m₂ : outer_measure α) (s : set α) : coe_fn (m₁ ⊔ m₂) s = coe_fn m₁ s ⊔ coe_fn m₂ s := sorry

/-- The pushforward of `m` along `f`. The outer measure on `s` is defined to be `m (f ⁻¹' s)`. -/
def map {α : Type u_1} {β : Type u_2} (f : α → β) : linear_map ennreal (outer_measure α) (outer_measure β) :=
  linear_map.mk (fun (m : outer_measure α) => mk (fun (s : set β) => coe_fn m (f ⁻¹' s)) (empty m) sorry sorry) sorry
    sorry

@[simp] theorem map_apply {α : Type u_1} {β : Type u_2} (f : α → β) (m : outer_measure α) (s : set β) : coe_fn (coe_fn (map f) m) s = coe_fn m (f ⁻¹' s) :=
  rfl

@[simp] theorem map_id {α : Type u_1} (m : outer_measure α) : coe_fn (map id) m = m :=
  ext fun (s : set α) => rfl

@[simp] theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → β) (g : β → γ) (m : outer_measure α) : coe_fn (map g) (coe_fn (map f) m) = coe_fn (map (g ∘ f)) m :=
  ext fun (s : set γ) => rfl

protected instance functor : Functor outer_measure :=
  { map := fun (α β : Type u_1) (f : α → β) => ⇑(map f),
    mapConst := fun (α β : Type u_1) => (fun (f : β → α) => ⇑(map f)) ∘ function.const β }

protected instance is_lawful_functor : is_lawful_functor outer_measure :=
  is_lawful_functor.mk (fun (α : Type u_1) => map_id)
    fun (α β γ : Type u_1) (f : α → β) (g : β → γ) (m : outer_measure α) => Eq.symm (map_map f g m)

/-- The dirac outer measure. -/
def dirac {α : Type u_1} (a : α) : outer_measure α :=
  mk (fun (s : set α) => set.indicator s (fun (_x : α) => 1) a) sorry sorry sorry

@[simp] theorem dirac_apply {α : Type u_1} (a : α) (s : set α) : coe_fn (dirac a) s = set.indicator s (fun (_x : α) => 1) a :=
  rfl

/-- The sum of an (arbitrary) collection of outer measures. -/
def sum {α : Type u_1} {ι : Type u_2} (f : ι → outer_measure α) : outer_measure α :=
  mk (fun (s : set α) => tsum fun (i : ι) => coe_fn (f i) s) sorry sorry sorry

@[simp] theorem sum_apply {α : Type u_1} {ι : Type u_2} (f : ι → outer_measure α) (s : set α) : coe_fn (sum f) s = tsum fun (i : ι) => coe_fn (f i) s :=
  rfl

theorem smul_dirac_apply {α : Type u_1} (a : ennreal) (b : α) (s : set α) : coe_fn (a • dirac b) s = set.indicator s (fun (_x : α) => a) b := sorry

/-- Pullback of an `outer_measure`: `comap f μ s = μ (f '' s)`. -/
def comap {α : Type u_1} {β : Type u_2} (f : α → β) : linear_map ennreal (outer_measure β) (outer_measure α) :=
  linear_map.mk (fun (m : outer_measure β) => mk (fun (s : set α) => coe_fn m (f '' s)) sorry sorry sorry) sorry sorry

@[simp] theorem comap_apply {α : Type u_1} {β : Type u_2} (f : α → β) (m : outer_measure β) (s : set α) : coe_fn (coe_fn (comap f) m) s = coe_fn m (f '' s) :=
  rfl

/-- Restrict an `outer_measure` to a set. -/
def restrict {α : Type u_1} (s : set α) : linear_map ennreal (outer_measure α) (outer_measure α) :=
  linear_map.comp (map coe) (comap coe)

@[simp] theorem restrict_apply {α : Type u_1} (s : set α) (t : set α) (m : outer_measure α) : coe_fn (coe_fn (restrict s) m) t = coe_fn m (t ∩ s) := sorry

theorem top_apply {α : Type u_1} {s : set α} (h : set.nonempty s) : coe_fn ⊤ s = ⊤ := sorry

/-- Given any function `m` assigning measures to sets satisying `m ∅ = 0`, there is
  a unique maximal outer measure `μ` satisfying `μ s ≤ m s` for all `s : set α`. -/
protected def of_function {α : Type u_1} (m : set α → ennreal) (m_empty : m ∅ = 0) : outer_measure α :=
  let μ : set α → ennreal :=
    fun (s : set α) =>
      infi fun {f : ℕ → set α} => infi fun (h : s ⊆ set.Union fun (i : ℕ) => f i) => tsum fun (i : ℕ) => m (f i);
  mk μ sorry sorry sorry

theorem of_function_apply {α : Type u_1} (m : set α → ennreal) (m_empty : m ∅ = 0) (s : set α) : coe_fn (outer_measure.of_function m m_empty) s =
  infi fun (t : ℕ → set α) => infi fun (h : s ⊆ set.Union t) => tsum fun (n : ℕ) => m (t n) :=
  rfl

theorem of_function_le {α : Type u_1} {m : set α → ennreal} {m_empty : m ∅ = 0} (s : set α) : coe_fn (outer_measure.of_function m m_empty) s ≤ m s := sorry

theorem of_function_eq {α : Type u_1} {m : set α → ennreal} {m_empty : m ∅ = 0} (s : set α) (m_mono : ∀ {t : set α}, s ⊆ t → m s ≤ m t) (m_subadd : ∀ (s : ℕ → set α), m (set.Union fun (i : ℕ) => s i) ≤ tsum fun (i : ℕ) => m (s i)) : coe_fn (outer_measure.of_function m m_empty) s = m s :=
  le_antisymm (of_function_le s)
    (le_infi
      fun (f : ℕ → set α) => le_infi fun (hf : s ⊆ set.Union fun (i : ℕ) => f i) => le_trans (m_mono hf) (m_subadd f))

theorem le_of_function {α : Type u_1} {m : set α → ennreal} {m_empty : m ∅ = 0} {μ : outer_measure α} : μ ≤ outer_measure.of_function m m_empty ↔ ∀ (s : set α), coe_fn μ s ≤ m s := sorry

/-- Given any function `m` assigning measures to sets, there is a unique maximal outer measure `μ`
  satisfying `μ s ≤ m s` for all `s : set α`. This is the same as `outer_measure.of_function`,
  except that it doesn't require `m ∅ = 0`. -/
def bounded_by {α : Type u_1} (m : set α → ennreal) : outer_measure α :=
  outer_measure.of_function (fun (s : set α) => supr fun (h : set.nonempty s) => m s) sorry

theorem bounded_by_le {α : Type u_1} {m : set α → ennreal} (s : set α) : coe_fn (bounded_by m) s ≤ m s :=
  has_le.le.trans (of_function_le s) supr_const_le

theorem bounded_by_eq_of_function {α : Type u_1} {m : set α → ennreal} (m_empty : m ∅ = 0) (s : set α) : coe_fn (bounded_by m) s = coe_fn (outer_measure.of_function m m_empty) s := sorry

theorem bounded_by_apply {α : Type u_1} {m : set α → ennreal} (s : set α) : coe_fn (bounded_by m) s =
  infi
    fun (t : ℕ → set α) =>
      infi fun (h : s ⊆ set.Union t) => tsum fun (n : ℕ) => supr fun (h : set.nonempty (t n)) => m (t n) := sorry

theorem bounded_by_eq {α : Type u_1} {m : set α → ennreal} (s : set α) (m_empty : m ∅ = 0) (m_mono : ∀ {t : set α}, s ⊆ t → m s ≤ m t) (m_subadd : ∀ (s : ℕ → set α), m (set.Union fun (i : ℕ) => s i) ≤ tsum fun (i : ℕ) => m (s i)) : coe_fn (bounded_by m) s = m s := sorry

theorem le_bounded_by {α : Type u_1} {m : set α → ennreal} {μ : outer_measure α} : μ ≤ bounded_by m ↔ ∀ (s : set α), coe_fn μ s ≤ m s := sorry

theorem le_bounded_by' {α : Type u_1} {m : set α → ennreal} {μ : outer_measure α} : μ ≤ bounded_by m ↔ ∀ (s : set α), set.nonempty s → coe_fn μ s ≤ m s := sorry

/-- A set `s` is Carathéodory-measurable for an outer measure `m` if for all sets `t` we have
  `m t = m (t ∩ s) + m (t \ s)`. -/
def is_caratheodory {α : Type u} (m : outer_measure α) (s : set α) :=
  ∀ (t : set α), coe_fn m t = coe_fn m (t ∩ s) + coe_fn m (t \ s)

theorem is_caratheodory_iff_le' {α : Type u} (m : outer_measure α) {s : set α} : is_caratheodory m s ↔ ∀ (t : set α), coe_fn m (t ∩ s) + coe_fn m (t \ s) ≤ coe_fn m t :=
  forall_congr fun (t : set α) => iff.trans le_antisymm_iff (and_iff_right (le_inter_add_diff s))

@[simp] theorem is_caratheodory_empty {α : Type u} (m : outer_measure α) : is_caratheodory m ∅ := sorry

theorem is_caratheodory_compl {α : Type u} (m : outer_measure α) {s₁ : set α} : is_caratheodory m s₁ → is_caratheodory m (s₁ᶜ) := sorry

@[simp] theorem is_caratheodory_compl_iff {α : Type u} (m : outer_measure α) {s : set α} : is_caratheodory m (sᶜ) ↔ is_caratheodory m s := sorry

theorem is_caratheodory_union {α : Type u} (m : outer_measure α) {s₁ : set α} {s₂ : set α} (h₁ : is_caratheodory m s₁) (h₂ : is_caratheodory m s₂) : is_caratheodory m (s₁ ∪ s₂) := sorry

theorem measure_inter_union {α : Type u} (m : outer_measure α) {s₁ : set α} {s₂ : set α} (h : s₁ ∩ s₂ ⊆ ∅) (h₁ : is_caratheodory m s₁) {t : set α} : coe_fn m (t ∩ (s₁ ∪ s₂)) = coe_fn m (t ∩ s₁) + coe_fn m (t ∩ s₂) := sorry

theorem is_caratheodory_Union_lt {α : Type u} (m : outer_measure α) {s : ℕ → set α} {n : ℕ} : (∀ (i : ℕ), i < n → is_caratheodory m (s i)) →
  is_caratheodory m (set.Union fun (i : ℕ) => set.Union fun (H : i < n) => s i) := sorry

theorem is_caratheodory_inter {α : Type u} (m : outer_measure α) {s₁ : set α} {s₂ : set α} (h₁ : is_caratheodory m s₁) (h₂ : is_caratheodory m s₂) : is_caratheodory m (s₁ ∩ s₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_caratheodory m (s₁ ∩ s₂))) (Eq.symm (propext (is_caratheodory_compl_iff m)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_caratheodory m (s₁ ∩ s₂ᶜ))) (set.compl_inter s₁ s₂)))
      (is_caratheodory_union m (is_caratheodory_compl m h₁) (is_caratheodory_compl m h₂)))

theorem is_caratheodory_sum {α : Type u} (m : outer_measure α) {s : ℕ → set α} (h : ∀ (i : ℕ), is_caratheodory m (s i)) (hd : pairwise (disjoint on s)) {t : set α} {n : ℕ} : (finset.sum (finset.range n) fun (i : ℕ) => coe_fn m (t ∩ s i)) =
  coe_fn m (t ∩ set.Union fun (i : ℕ) => set.Union fun (H : i < n) => s i) := sorry

theorem is_caratheodory_Union_nat {α : Type u} (m : outer_measure α) {s : ℕ → set α} (h : ∀ (i : ℕ), is_caratheodory m (s i)) (hd : pairwise (disjoint on s)) : is_caratheodory m (set.Union fun (i : ℕ) => s i) := sorry

theorem f_Union {α : Type u} (m : outer_measure α) {s : ℕ → set α} (h : ∀ (i : ℕ), is_caratheodory m (s i)) (hd : pairwise (disjoint on s)) : coe_fn m (set.Union fun (i : ℕ) => s i) = tsum fun (i : ℕ) => coe_fn m (s i) := sorry

/-- The Carathéodory-measurable sets for an outer measure `m` form a Dynkin system.  -/
def caratheodory_dynkin {α : Type u} (m : outer_measure α) : measurable_space.dynkin_system α :=
  measurable_space.dynkin_system.mk (is_caratheodory m) (is_caratheodory_empty m) sorry sorry

/-- Given an outer measure `μ`, the Carathéodory-measurable space is
  defined such that `s` is measurable if `∀t, μ t = μ (t ∩ s) + μ (t \ s)`. -/
protected def caratheodory {α : Type u} (m : outer_measure α) : measurable_space α :=
  measurable_space.dynkin_system.to_measurable_space (caratheodory_dynkin m) sorry

theorem is_caratheodory_iff {α : Type u} (m : outer_measure α) {s : set α} : measurable_space.is_measurable' (outer_measure.caratheodory m) s ↔
  ∀ (t : set α), coe_fn m t = coe_fn m (t ∩ s) + coe_fn m (t \ s) :=
  iff.rfl

theorem is_caratheodory_iff_le {α : Type u} (m : outer_measure α) {s : set α} : measurable_space.is_measurable' (outer_measure.caratheodory m) s ↔
  ∀ (t : set α), coe_fn m (t ∩ s) + coe_fn m (t \ s) ≤ coe_fn m t :=
  is_caratheodory_iff_le' m

protected theorem Union_eq_of_caratheodory {α : Type u} (m : outer_measure α) {s : ℕ → set α} (h : ∀ (i : ℕ), measurable_space.is_measurable' (outer_measure.caratheodory m) (s i)) (hd : pairwise (disjoint on s)) : coe_fn m (set.Union fun (i : ℕ) => s i) = tsum fun (i : ℕ) => coe_fn m (s i) :=
  f_Union m h hd

theorem of_function_caratheodory {α : Type u_1} {m : set α → ennreal} {s : set α} {h₀ : m ∅ = 0} (hs : ∀ (t : set α), m (t ∩ s) + m (t \ s) ≤ m t) : measurable_space.is_measurable' (outer_measure.caratheodory (outer_measure.of_function m h₀)) s := sorry

theorem bounded_by_caratheodory {α : Type u_1} {m : set α → ennreal} {s : set α} (hs : ∀ (t : set α), m (t ∩ s) + m (t \ s) ≤ m t) : measurable_space.is_measurable' (outer_measure.caratheodory (bounded_by m)) s := sorry

@[simp] theorem zero_caratheodory {α : Type u_1} : outer_measure.caratheodory 0 = ⊤ :=
  top_unique fun (s : set α) (_x : measurable_space.is_measurable' ⊤ s) (t : set α) => Eq.symm (add_zero (coe_fn 0 t))

theorem top_caratheodory {α : Type u_1} : outer_measure.caratheodory ⊤ = ⊤ := sorry

theorem le_add_caratheodory {α : Type u_1} (m₁ : outer_measure α) (m₂ : outer_measure α) : outer_measure.caratheodory m₁ ⊓ outer_measure.caratheodory m₂ ≤ outer_measure.caratheodory (m₁ + m₂) := sorry

theorem le_sum_caratheodory {α : Type u_1} {ι : Type u_2} (m : ι → outer_measure α) : (infi fun (i : ι) => outer_measure.caratheodory (m i)) ≤ outer_measure.caratheodory (sum m) := sorry

theorem le_smul_caratheodory {α : Type u_1} (a : ennreal) (m : outer_measure α) : outer_measure.caratheodory m ≤ outer_measure.caratheodory (a • m) := sorry

@[simp] theorem dirac_caratheodory {α : Type u_1} (a : α) : outer_measure.caratheodory (dirac a) = ⊤ := sorry

/-- Given a set of outer measures, we define a new function that on a set `s` is defined to be the
  infimum of `μ(s)` for the outer measures `μ` in the collection. We ensure that this
  function is defined to be `0` on `∅`, even if the collection of outer measures is empty.
  The outer measure generated by this function is the infimum of the given outer measures. -/
def Inf_gen {α : Type u_1} (m : set (outer_measure α)) (s : set α) : ennreal :=
  infi fun (μ : outer_measure α) => infi fun (h : μ ∈ m) => coe_fn μ s

theorem Inf_gen_def {α : Type u_1} (m : set (outer_measure α)) (t : set α) : Inf_gen m t = infi fun (μ : outer_measure α) => infi fun (h : μ ∈ m) => coe_fn μ t :=
  rfl

theorem Inf_eq_bounded_by_Inf_gen {α : Type u_1} (m : set (outer_measure α)) : Inf m = bounded_by (Inf_gen m) := sorry

theorem supr_Inf_gen_nonempty {α : Type u_1} {m : set (outer_measure α)} (h : set.nonempty m) (t : set α) : (supr fun (h : set.nonempty t) => Inf_gen m t) = infi fun (μ : outer_measure α) => infi fun (h : μ ∈ m) => coe_fn μ t := sorry

/-- The value of the Infimum of a nonempty set of outer measures on a set is not simply
the minimum value of a measure on that set: it is the infimum sum of measures of countable set of
sets that covers that set, where a different measure can be used for each set in the cover. -/
theorem Inf_apply {α : Type u_1} {m : set (outer_measure α)} {s : set α} (h : set.nonempty m) : coe_fn (Inf m) s =
  infi
    fun (t : ℕ → set α) =>
      infi
        fun (h2 : s ⊆ set.Union t) =>
          tsum fun (n : ℕ) => infi fun (μ : outer_measure α) => infi fun (h3 : μ ∈ m) => coe_fn μ (t n) := sorry

/-- This proves that Inf and restrict commute for outer measures, so long as the set of
outer measures is nonempty. -/
theorem restrict_Inf_eq_Inf_restrict {α : Type u_1} (m : set (outer_measure α)) {s : set α} (hm : set.nonempty m) : coe_fn (restrict s) (Inf m) = Inf (⇑(restrict s) '' m) := sorry

end outer_measure

/-! ### Induced Outer Measure

  We can extend a function defined on a subset of `set α` to an outer measure.
  The underlying function is called `extend`, and the measure it induces is called
  `induced_outer_measure`.

  Some lemmas below are proven twice, once in the general case, and one where the function `m`
  is only defined on measurable sets (i.e. when `P = is_measurable`). In the latter cases, we can
  remove some hypotheses in the statement. The general version has the same name, but with a prime
  at the end. -/

/-- We can trivially extend a function defined on a subclass of objects (with codomain `ennreal`)
  to all objects by defining it to be `∞` on the objects not in the class. -/
def extend {α : Type u_1} {P : α → Prop} (m : (s : α) → P s → ennreal) (s : α) : ennreal :=
  infi fun (h : P s) => m s h

theorem extend_eq {α : Type u_1} {P : α → Prop} (m : (s : α) → P s → ennreal) {s : α} (h : P s) : extend m s = m s h := sorry

theorem le_extend {α : Type u_1} {P : α → Prop} (m : (s : α) → P s → ennreal) {s : α} (h : P s) : m s h ≤ extend m s := sorry

theorem extend_empty {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (P0 : P ∅) (m0 : m ∅ P0 = 0) : extend m ∅ = 0 :=
  Eq.trans (extend_eq m P0) m0

theorem extend_Union_nat {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)) (mU : m (set.Union fun (i : ℕ) => f i) (PU hm) = tsum fun (i : ℕ) => m (f i) (hm i)) : extend m (set.Union fun (i : ℕ) => f i) = tsum fun (i : ℕ) => extend m (f i) := sorry

theorem extend_Union_le_tsum_nat' {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (s : ℕ → set α) : extend m (set.Union fun (i : ℕ) => s i) ≤ tsum fun (i : ℕ) => extend m (s i) := sorry

theorem extend_mono' {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) {s₁ : set α} {s₂ : set α} (h₁ : P s₁) (hs : s₁ ⊆ s₂) : extend m s₁ ≤ extend m s₂ :=
  le_infi fun (h₂ : P s₂) => eq.mpr (id (Eq._oldrec (Eq.refl (extend m s₁ ≤ m s₂ h₂)) (extend_eq m h₁))) (m_mono h₁ h₂ hs)

theorem extend_Union {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (P0 : P ∅) (m0 : m ∅ P0 = 0) (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  pairwise (disjoint on f) → m (set.Union fun (i : ℕ) => f i) (PU hm) = tsum fun (i : ℕ) => m (f i) (hm i)) {β : Type u_2} [encodable β] {f : β → set α} (hd : pairwise (disjoint on f)) (hm : ∀ (i : β), P (f i)) : extend m (set.Union fun (i : β) => f i) = tsum fun (i : β) => extend m (f i) := sorry

theorem extend_union {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} (P0 : P ∅) (m0 : m ∅ P0 = 0) (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  pairwise (disjoint on f) → m (set.Union fun (i : ℕ) => f i) (PU hm) = tsum fun (i : ℕ) => m (f i) (hm i)) {s₁ : set α} {s₂ : set α} (hd : disjoint s₁ s₂) (h₁ : P s₁) (h₂ : P s₂) : extend m (s₁ ∪ s₂) = extend m s₁ + extend m s₂ := sorry

/-- Given an arbitrary function on a subset of sets, we can define the outer measure corresponding
  to it (this is the unique maximal outer measure that is at most `m` on the domain of `m`). -/
def induced_outer_measure {α : Type u_1} {P : set α → Prop} (m : (s : set α) → P s → ennreal) (P0 : P ∅) (m0 : m ∅ P0 = 0) : outer_measure α :=
  outer_measure.of_function (extend m) sorry

theorem induced_outer_measure_eq_extend' {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) {s : set α} (hs : P s) : coe_fn (induced_outer_measure m P0 m0) s = extend m s :=
  outer_measure.of_function_eq s (fun (t : set α) => extend_mono' m_mono hs) (extend_Union_le_tsum_nat' PU msU)

theorem induced_outer_measure_eq' {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) {s : set α} (hs : P s) : coe_fn (induced_outer_measure m P0 m0) s = m s hs :=
  Eq.trans (induced_outer_measure_eq_extend' PU msU m_mono hs) (extend_eq m hs)

theorem induced_outer_measure_eq_infi {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) (s : set α) : coe_fn (induced_outer_measure m P0 m0) s = infi fun (t : set α) => infi fun (ht : P t) => infi fun (h : s ⊆ t) => m t ht := sorry

theorem induced_outer_measure_preimage {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) (f : α ≃ α) (Pm : ∀ (s : set α), P (⇑f ⁻¹' s) ↔ P s) (mm : ∀ (s : set α) (hs : P s), m (⇑f ⁻¹' s) (iff.mpr (Pm s) hs) = m s hs) {A : set α} : coe_fn (induced_outer_measure m P0 m0) (⇑f ⁻¹' A) = coe_fn (induced_outer_measure m P0 m0) A := sorry

theorem induced_outer_measure_exists_set {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) {s : set α} (hs : coe_fn (induced_outer_measure m P0 m0) s < ⊤) {ε : nnreal} (hε : 0 < ε) : ∃ (t : set α),
  ∃ (ht : P t), s ⊆ t ∧ coe_fn (induced_outer_measure m P0 m0) t ≤ coe_fn (induced_outer_measure m P0 m0) s + ↑ε := sorry

/-- To test whether `s` is Carathéodory-measurable we only need to check the sets `t` for which
  `P t` holds. See `of_function_caratheodory` for another way to show the Carathéodory-measurability
  of `s`.
-/
theorem induced_outer_measure_caratheodory {α : Type u_1} {P : set α → Prop} {m : (s : set α) → P s → ennreal} {P0 : P ∅} {m0 : m ∅ P0 = 0} (PU : ∀ {f : ℕ → set α}, (∀ (i : ℕ), P (f i)) → P (set.Union fun (i : ℕ) => f i)) (msU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), P (f i)),
  m (set.Union fun (i : ℕ) => f i) (PU hm) ≤ tsum fun (i : ℕ) => m (f i) (hm i)) (m_mono : ∀ {s₁ s₂ : set α} (hs₁ : P s₁) (hs₂ : P s₂), s₁ ⊆ s₂ → m s₁ hs₁ ≤ m s₂ hs₂) (s : set α) : measurable_space.is_measurable' (outer_measure.caratheodory (induced_outer_measure m P0 m0)) s ↔
  ∀ (t : set α),
    P t →
      coe_fn (induced_outer_measure m P0 m0) (t ∩ s) + coe_fn (induced_outer_measure m P0 m0) (t \ s) ≤
        coe_fn (induced_outer_measure m P0 m0) t := sorry

/-! If `P` is `is_measurable` for some measurable space, then we can remove some hypotheses of the
  above lemmas. -/

theorem extend_mono {α : Type u_1} [measurable_space α] {m : (s : set α) → is_measurable s → ennreal} (m0 : m ∅ is_measurable.empty = 0) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), is_measurable (f i)),
  pairwise (disjoint on f) →
    m (set.Union fun (i : ℕ) => f i) (is_measurable.Union hm) = tsum fun (i : ℕ) => m (f i) (hm i)) {s₁ : set α} {s₂ : set α} (h₁ : is_measurable s₁) (hs : s₁ ⊆ s₂) : extend m s₁ ≤ extend m s₂ := sorry

theorem extend_Union_le_tsum_nat {α : Type u_1} [measurable_space α] {m : (s : set α) → is_measurable s → ennreal} (m0 : m ∅ is_measurable.empty = 0) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), is_measurable (f i)),
  pairwise (disjoint on f) →
    m (set.Union fun (i : ℕ) => f i) (is_measurable.Union hm) = tsum fun (i : ℕ) => m (f i) (hm i)) (s : ℕ → set α) : extend m (set.Union fun (i : ℕ) => s i) ≤ tsum fun (i : ℕ) => extend m (s i) := sorry

theorem induced_outer_measure_eq_extend {α : Type u_1} [measurable_space α] {m : (s : set α) → is_measurable s → ennreal} (m0 : m ∅ is_measurable.empty = 0) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), is_measurable (f i)),
  pairwise (disjoint on f) →
    m (set.Union fun (i : ℕ) => f i) (is_measurable.Union hm) = tsum fun (i : ℕ) => m (f i) (hm i)) {s : set α} (hs : is_measurable s) : coe_fn (induced_outer_measure m is_measurable.empty m0) s = extend m s :=
  outer_measure.of_function_eq s (fun (t : set α) => extend_mono m0 mU hs) (extend_Union_le_tsum_nat m0 mU)

theorem induced_outer_measure_eq {α : Type u_1} [measurable_space α] {m : (s : set α) → is_measurable s → ennreal} (m0 : m ∅ is_measurable.empty = 0) (mU : ∀ {f : ℕ → set α} (hm : ∀ (i : ℕ), is_measurable (f i)),
  pairwise (disjoint on f) →
    m (set.Union fun (i : ℕ) => f i) (is_measurable.Union hm) = tsum fun (i : ℕ) => m (f i) (hm i)) {s : set α} (hs : is_measurable s) : coe_fn (induced_outer_measure m is_measurable.empty m0) s = m s hs :=
  Eq.trans (induced_outer_measure_eq_extend m0 mU hs) (extend_eq m hs)

namespace outer_measure

/-- Given an outer measure `m` we can forget its value on non-measurable sets, and then consider
  `m.trim`, the unique maximal outer measure less than that function. -/
def trim {α : Type u_1} [measurable_space α] (m : outer_measure α) : outer_measure α :=
  induced_outer_measure (fun (s : set α) (_x : is_measurable s) => coe_fn m s) is_measurable.empty (empty m)

theorem le_trim {α : Type u_1} [measurable_space α] (m : outer_measure α) : m ≤ trim m :=
  iff.mpr le_of_function fun (s : set α) => le_infi fun (_x : is_measurable s) => le_refl (coe_fn m s)

theorem trim_eq {α : Type u_1} [measurable_space α] (m : outer_measure α) {s : set α} (hs : is_measurable s) : coe_fn (trim m) s = coe_fn m s := sorry

theorem trim_congr {α : Type u_1} [measurable_space α] {m₁ : outer_measure α} {m₂ : outer_measure α} (H : ∀ {s : set α}, is_measurable s → coe_fn m₁ s = coe_fn m₂ s) : trim m₁ = trim m₂ := sorry

theorem trim_le_trim {α : Type u_1} [measurable_space α] {m₁ : outer_measure α} {m₂ : outer_measure α} (H : m₁ ≤ m₂) : trim m₁ ≤ trim m₂ := sorry

theorem le_trim_iff {α : Type u_1} [measurable_space α] {m₁ : outer_measure α} {m₂ : outer_measure α} : m₁ ≤ trim m₂ ↔ ∀ (s : set α), is_measurable s → coe_fn m₁ s ≤ coe_fn m₂ s :=
  iff.trans le_of_function (forall_congr fun (s : set α) => le_infi_iff)

theorem trim_eq_infi {α : Type u_1} [measurable_space α] (m : outer_measure α) (s : set α) : coe_fn (trim m) s = infi fun (t : set α) => infi fun (st : s ⊆ t) => infi fun (ht : is_measurable t) => coe_fn m t := sorry

theorem trim_eq_infi' {α : Type u_1} [measurable_space α] (m : outer_measure α) (s : set α) : coe_fn (trim m) s = infi fun (t : Subtype fun (t : set α) => s ⊆ t ∧ is_measurable t) => coe_fn m ↑t := sorry

theorem trim_trim {α : Type u_1} [measurable_space α] (m : outer_measure α) : trim (trim m) = trim m := sorry

@[simp] theorem trim_zero {α : Type u_1} [measurable_space α] : trim 0 = 0 := sorry

theorem trim_add {α : Type u_1} [measurable_space α] (m₁ : outer_measure α) (m₂ : outer_measure α) : trim (m₁ + m₂) = trim m₁ + trim m₂ := sorry

theorem trim_sum_ge {α : Type u_1} [measurable_space α] {ι : Type u_2} (m : ι → outer_measure α) : (sum fun (i : ι) => trim (m i)) ≤ trim (sum m) := sorry

theorem exists_is_measurable_superset_eq_trim {α : Type u_1} [measurable_space α] (m : outer_measure α) (s : set α) : ∃ (t : set α), s ⊆ t ∧ is_measurable t ∧ coe_fn m t = coe_fn (trim m) s := sorry

theorem exists_is_measurable_superset_of_trim_eq_zero {α : Type u_1} [measurable_space α] {m : outer_measure α} {s : set α} (h : coe_fn (trim m) s = 0) : ∃ (t : set α), s ⊆ t ∧ is_measurable t ∧ coe_fn m t = 0 := sorry

theorem trim_smul {α : Type u_1} [measurable_space α] (c : ennreal) (m : outer_measure α) : trim (c • m) = c • trim m := sorry

/-- The trimmed property of a measure μ states that `μ.to_outer_measure.trim = μ.to_outer_measure`.
This theorem shows that a restricted trimmed outer measure is a trimmed outer measure. -/
theorem restrict_trim {α : Type u_1} [measurable_space α] {μ : outer_measure α} {s : set α} (hs : is_measurable s) : trim (coe_fn (restrict s) μ) = coe_fn (restrict s) (trim μ) := sorry


import algebra.field
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import gtm106.weierstrass_equation.linear_change_of_variable.basic
import gtm106.weierstrass_equation.linear_change_of_variable.change_curve
import tactic

namespace linear_change_of_variable

-- ================
-- Linear change of variables act on points
-- ================

def change_affine_point_back {K : Type*} [field K]
(C : linear_change_of_variable K) (P : affine_plane_point K) : affine_plane_point K :=
⟨ C.u^2*P.x + C.r, C.u^3*P.y + C.u^2*C.s*P.x + C.t ⟩

def change_projective_point_back' {K : Type*} [field K]
(C : linear_change_of_variable K) (P : projective_plane_point' K) : projective_plane_point' K :=
⟨ C.u^2*P.X + C.r*P.Z, C.u^3*P.Y + C.u^2*C.s*P.X + C.t*P.Z, P.Z, by {
  rintros ⟨ hX, hY, hZ ⟩,
  simp [hZ] at hX,
  simp [hZ, hX] at hY,
  exact P.h ⟨ hX, hY, hZ ⟩,
} ⟩

def change_projective_point_back {K : Type*} [field K]
(C : linear_change_of_variable K) (P : projective_plane_point K) : projective_plane_point K :=
quotient.lift (λ (P : projective_plane_point' K), quotient.mk (C.change_projective_point_back' P))
(by {
  rintros P P' ⟨ k, h1, h2, h3, h4 ⟩,
  simp,
  use k,
  simp [change_projective_point_back', h1, h2, h3, h4],
  split, { ring, }, ring,
}) P

def change_affine_point {K : Type*} [field K]
(C : linear_change_of_variable K) (P : affine_plane_point K) : affine_plane_point K :=
⟨ P.x/C.u^2 - C.r/C.u^2, P.y/C.u^3 - C.s*P.x/C.u^3 + (C.r*C.s-C.t)/C.u^3 ⟩

namespace change_affine_point

@[simp]
lemma id {K : Type*} [field K]
(P : affine_plane_point K) :
(identity K).change_affine_point P = P :=
begin
  simp [identity, change_affine_point, affine_plane_point.ext_iff],
end

lemma comp {K : Type*} [field K]
(C C' : linear_change_of_variable K) (P : affine_plane_point K) :
C.change_affine_point (C'.change_affine_point P) = (C.composite C').change_affine_point P :=
begin
  simp [composite, change_affine_point, affine_plane_point.ext_iff],
  split, { field_simp, ring, },
  field_simp, ring,
end

instance to_has_scalar (K : Type*) [h : field K]
: has_scalar (linear_change_of_variable K) (affine_plane_point K)
:= ⟨ change_affine_point ⟩

instance to_mul_action (K : Type*) [h : field K]
: mul_action (linear_change_of_variable K) (affine_plane_point K)
:= ⟨ @id K h, by {
  intros _ _ _, simp only [has_mul.mul, has_scalar.smul,
    mul_one_class.mul, monoid.mul, div_inv_monoid.mul, group.mul, comp],
} ⟩

end change_affine_point

-- no denominator version
def change_projective_point' {K : Type*} [field K]
(C : linear_change_of_variable K) (P : projective_plane_point' K) : projective_plane_point' K :=
⟨ P.X*C.u - P.Z*C.r*C.u, P.Y - C.s*P.X + P.Z*(C.r*C.s-C.t), P.Z*C.u^3, by {
  rintros ⟨ hX, hY, hZ ⟩,
  simp at hZ,
  simp [hZ] at hX,
  simp [hZ, hX] at hY,
  exact P.h ⟨ hX, hY, hZ ⟩,
} ⟩

def change_projective_point {K : Type*} [field K]
(C : linear_change_of_variable K) (P : projective_plane_point K) : projective_plane_point K :=
quotient.lift (λ (P : projective_plane_point' K), quotient.mk (C.change_projective_point' P))
(by {
  rintros P P' ⟨ k, h1, h2, h3, h4 ⟩,
  simp,
  use k,
  simp [change_projective_point', h1, h2, h3, h4],
  split, { ring, }, split, { ring, }, ring,
}) P

namespace change_projective_point

@[simp]
lemma id {K : Type*} [field K]
(P : projective_plane_point K) :
(identity K).change_projective_point P = P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [identity, change_projective_point, change_projective_point'],
  use 1,
  simp,
end

lemma comp {K : Type*} [field K]
(C C' : linear_change_of_variable K) (P : projective_plane_point K) :
C.change_projective_point (C'.change_projective_point P) = (C.composite C').change_projective_point P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [composite, change_projective_point, change_projective_point'],
  use 1,
  simp,
  split, { ring, }, split, { ring, }, ring,
end

instance to_has_scalar (K : Type*) [h : field K]
: has_scalar (linear_change_of_variable K) (projective_plane_point K)
:= ⟨ change_projective_point ⟩

instance to_mul_action (K : Type*) [h : field K]
: mul_action (linear_change_of_variable K) (projective_plane_point K)
:= ⟨ @id K h, by {
  intros _ _ _, simp only [has_mul.mul, has_scalar.smul,
    mul_one_class.mul, monoid.mul, div_inv_monoid.mul, group.mul, comp],
} ⟩

end change_projective_point

-- ================
-- Properties of linear change of variables on points
-- ================

@[simp]
lemma change_affine_point_back.inv {K : Type*} [field K]
(C : linear_change_of_variable K) (P : affine_plane_point K) :
C.change_affine_point_back P = C.inverse.change_affine_point P :=
begin
  simp [change_affine_point_back, inverse, change_affine_point],
  split, { field_simp [pow_succ], ring, },
  field_simp [pow_succ], ring,
end

@[simp]
lemma change_projective_point_back.inv {K : Type*} [field K]
(C : linear_change_of_variable K) (P : projective_plane_point K) :
C.change_projective_point_back P = C.inverse.change_projective_point P :=
begin
  revert P,
  refine quotient.ind _,
  intro P,
  simp [change_projective_point_back, inverse, change_projective_point,
    change_projective_point_back', change_projective_point'],
  use 1/C.u^3,
  simp,
  split, { field_simp [pow_succ], ring, },
  split, { field_simp [pow_succ], ring, },
  field_simp [pow_succ],
end

@[simp]
lemma eval_at_affine_point {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
(P : affine_plane_point K) :
(C.change_curve E).eval_at_affine_point (C.change_affine_point P) = (E.eval_at_affine_point P)/C.u^6 :=
begin
  simp [weierstrass_equation.eval_at_affine_point,
    change_curve, change_affine_point],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma eval_dx_at_affine_point {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
(P : affine_plane_point K) :
(C.change_curve E).eval_dx_at_affine_point (C.change_affine_point P)
= (E.eval_dx_at_affine_point P + C.s * E.eval_dy_at_affine_point P)/C.u^4 :=
begin
  simp [weierstrass_equation.eval_dx_at_affine_point,
    weierstrass_equation.eval_dy_at_affine_point,
    change_curve, change_affine_point],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma eval_dy_at_affine_point {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
(P : affine_plane_point K) :
(C.change_curve E).eval_dy_at_affine_point (C.change_affine_point P) = (E.eval_dy_at_affine_point P)/C.u^3 :=
begin
  simp [weierstrass_equation.eval_dy_at_affine_point,
    change_curve, change_affine_point],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma eval_hessian_at_affine_point {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
(P : affine_plane_point K) :
(C.change_curve E).eval_hessian_at_affine_point (C.change_affine_point P) = (E.eval_hessian_at_affine_point P)/C.u^2 :=
begin
  simp [weierstrass_equation.eval_hessian_at_affine_point,
    weierstrass_equation.b2,
    change_curve, change_affine_point],
  field_simp [pow_succ],
  ring,
end

lemma preserve_affine_point
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (P : affine_plane_point K) :
E.affine_point_on_curve P ↔ (C.change_curve E).affine_point_on_curve
(C.change_affine_point P) :=
begin
  simp [weierstrass_equation.affine_point_on_curve],
end

lemma preserve_affine_regular_point
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (P : affine_plane_point K) :
E.affine_point_regular P ↔ (C.change_curve E).affine_point_regular
(C.change_affine_point P) :=
begin
  simp [weierstrass_equation.affine_point_regular, (C.preserve_affine_point E P).symm],
  intro h,
  split, {
    intros h1 h2 h3,
    simp [h3] at h1 h2,
    exact h1 h2,
  }, {
    intros h1 h2 h3,
    simp [h2, h3] at h1,
    exact h1,
  },
end

lemma preserve_affine_singular_point
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (P : affine_plane_point K) :
E.affine_point_singular P ↔ (C.change_curve E).affine_point_singular
(C.change_affine_point P) :=
begin
  by_cases h : E.affine_point_on_curve P, {
    rw [← E.affine_point_is_regular_or_singular P h,
      ← (C.change_curve E).affine_point_is_regular_or_singular _
      ((C.preserve_affine_point E P).1 h),
      C.preserve_affine_regular_point E P],
  },
  have h2 := h,
  rw C.preserve_affine_point E P at h,
  simp [weierstrass_equation.affine_point_singular, h, h2],
end

lemma preserve_node
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (P : affine_plane_point K) :
E.affine_point_is_node P ↔ (C.change_curve E).affine_point_is_node
(C.change_affine_point P) :=
begin
  simp [weierstrass_equation.affine_point_is_node,
    C.preserve_affine_singular_point E P],
end

lemma preserve_cusp
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (P : affine_plane_point K) :
E.affine_point_is_cusp P ↔ (C.change_curve E).affine_point_is_cusp
(C.change_affine_point P) :=
begin
  simp [weierstrass_equation.affine_point_is_cusp,
    C.preserve_affine_singular_point E P],
end

/-
lemma weierstrass_equation.change_curve_preserve_projective_point
{K : Type*} [field K] (E : weierstrass_equation K)
(C : linear_change_of_variable K) (X Y Z : K) :
let P' := C.change_projective_point X Y Z in
E.projective_point_on_curve X Y Z ↔ (C.change_curve E).projective_point_on_curve P'.1 P'.2.1 P'.2.2 :=
begin
  sorry,
end
-/

lemma preserve_non_singular {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.non_singular ↔ (C.change_curve E).non_singular :=
begin
  repeat { rw weierstrass_equation.non_singular_iff_affine_non_singular },
  unfold weierstrass_equation.affine_non_singular,
  split, {
    intros h P,
    replace h := h (C.inverse.change_affine_point P),
    rw [C.preserve_affine_point E _,
      C.preserve_affine_regular_point E _] at h,
    simp [change_affine_point.comp] at h,
    exact h,
  }, {
    intros h P,
    replace h := h (C.change_affine_point P),
    rw [← C.preserve_affine_point E _,
      ← C.preserve_affine_regular_point E _] at h,
    exact h,
  },
end

lemma preserve_has_node {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.has_node ↔ (C.change_curve E).has_node :=
begin
  unfold weierstrass_equation.has_node,
  split, {
    rintros ⟨ P, hP ⟩,
    use C.change_affine_point P,
    exact (C.preserve_node E P).1 hP,
  }, {
    rintros ⟨ P, hP ⟩,
    use C.inverse.change_affine_point P,
    rw [C.inverse.preserve_node _, ← change_curve.comp] at hP,
    simp at hP,
    exact hP,
  },
end

lemma preserve_has_cusp {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.has_cusp ↔ (C.change_curve E).has_cusp :=
begin
  unfold weierstrass_equation.has_cusp,
  split, {
    rintros ⟨ P, hP ⟩,
    use C.change_affine_point P,
    exact (C.preserve_cusp E P).1 hP,
  }, {
    rintros ⟨ P, hP ⟩,
    use C.inverse.change_affine_point P,
    rw [C.inverse.preserve_cusp _, ← change_curve.comp] at hP,
    simp at hP,
    exact hP,
  },
end

end linear_change_of_variable


variable (xs : List Nat)

theorem foo1 : xs = xs := by
  induction xs <;> rfl

theorem foo2 : xs = xs := by
  cases xs with
  | nil        => rfl
  | cons x xs  => rfl


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import order.partition.equipartition

/-!
# Equitabilising a partition

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

This file allows to blow partitions up into parts of controlled size. Given a partition `P` and
`a b m : ℕ`, we want to find a partition `Q` with `a` parts of size `m` and `b` parts of size
`m + 1` such that all parts of `P` are "as close as possible" to unions of parts of `Q`. By
"as close as possible", we mean that each part of `P` can be written as the union of some parts of
`Q` along with at most `m` other elements.

## Main declarations

* `finpartition.equitabilise`: `P.equitabilise h` where `h : a * m + b * (m + 1)` is a partition
  with `a` parts of size `m` and `b` parts of size `m + 1` which almost refines `P`.
* `finpartition.exists_equipartition_card_eq`: We can find equipartitions of arbitrary size.
-/

open finset nat

namespace finpartition
variables {α : Type*} [decidable_eq α] {s t : finset α} {m n a b : ℕ} {P : finpartition s}

/-- Given a partition `P` of `s`, as well as a proof that `a * m + b * (m + 1) = s.card`, we can
find a new partition `Q` of `s` where each part has size `m` or `m + 1`, every part of `P` is the
union of parts of `Q` plus at most `m` extra elements, there are `b` parts of size `m + 1` and
(provided `m > 0`, because a partition does not have parts of size `0`) there are `a` parts of size
`m` and hence `a + b` parts in total. -/

variables (P) (h : a * m + b * (m + 1) = s.card)

/-- Given a partition `P` of `s`, as well as a proof that `a * m + b * (m + 1) = s.card`, build a
new partition `Q` of `s` where each part has size `m` or `m + 1`, every part of `P` is the union of
parts of `Q` plus at most `m` extra elements, there are `b` parts of size `m + 1` and (provided
`m > 0`, because a partition does not have parts of size `0`) there are `a` parts of size `m` and
hence `a + b` parts in total. -/
noncomputable def equitabilise : finpartition s := (P.equitabilise_aux h).some

variables {P h}

lemma card_eq_of_mem_parts_equitabilise :
  t ∈ (P.equitabilise h).parts → t.card = m ∨ t.card = m + 1 :=
(P.equitabilise_aux h).some_spec.1 _

lemma equitabilise_is_equipartition : (P.equitabilise h).is_equipartition :=
set.equitable_on_iff_exists_eq_eq_add_one.2 ⟨m, λ u, card_eq_of_mem_parts_equitabilise⟩

variables (P h)

lemma card_filter_equitabilise_big :
  ((P.equitabilise h).parts.filter $ λ u : finset α, u.card = m + 1).card = b :=
(P.equitabilise_aux h).some_spec.2.2

lemma card_filter_equitabilise_small (hm : m ≠ 0) :
  ((P.equitabilise h).parts.filter $ λ u : finset α, u.card = m).card = a :=
begin
  refine (mul_eq_mul_right_iff.1 $ (add_left_inj (b * (m + 1))).1 _).resolve_right hm,
  rw [h, ←(P.equitabilise h).sum_card_parts],
  have hunion : (P.equitabilise h).parts = (P.equitabilise h).parts.filter (λ u, u.card = m) ∪
    (P.equitabilise h).parts.filter (λ u, u.card = m + 1),
  { rw [←filter_or, filter_true_of_mem],
    exact λ x, card_eq_of_mem_parts_equitabilise },
  nth_rewrite 1 hunion,
  rw [sum_union, sum_const_nat (λ x hx, (mem_filter.1 hx).2),
    sum_const_nat (λ x hx, (mem_filter.1 hx).2), P.card_filter_equitabilise_big],
  refine disjoint_filter_filter' _ _ _,
  intros x ha hb i h,
  apply succ_ne_self m _,
  exact (hb i h).symm.trans (ha i h),
end

lemma card_parts_equitabilise (hm : m ≠ 0) : (P.equitabilise h).parts.card = a + b :=
begin
  rw [←filter_true_of_mem (λ x, card_eq_of_mem_parts_equitabilise), filter_or, card_union_eq,
    P.card_filter_equitabilise_small _ hm, P.card_filter_equitabilise_big],
  exact disjoint_filter.2 (λ x _ h₀ h₁, nat.succ_ne_self m $ h₁.symm.trans h₀),
  apply_instance
end

lemma card_parts_equitabilise_subset_le :
  t ∈ P.parts → (t \ ((P.equitabilise h).parts.filter $ λ u, u ⊆ t).bUnion id).card ≤ m :=
(classical.some_spec $ P.equitabilise_aux h).2.1 t

variables (s)

/-- We can find equipartitions of arbitrary size. -/
lemma exists_equipartition_card_eq (hn : n ≠ 0) (hs : n ≤ s.card) :
  ∃ P : finpartition s, P.is_equipartition ∧ P.parts.card = n :=
begin
  rw ←pos_iff_ne_zero at hn,
  have : (n - s.card % n) * (s.card / n) + (s.card % n) * (s.card / n + 1) = s.card,
  { rw [tsub_mul, mul_add, ←add_assoc, tsub_add_cancel_of_le
    (nat.mul_le_mul_right _ (mod_lt _ hn).le), mul_one, add_comm, mod_add_div] },
  refine ⟨(indiscrete (card_pos.1 $ hn.trans_le hs).ne_empty).equitabilise this,
    equitabilise_is_equipartition, _⟩,
  rw [card_parts_equitabilise _ _ (nat.div_pos hs hn).ne', tsub_add_cancel_of_le (mod_lt _ hn).le],
end

end finpartition


import data.list
import data.list.basic
import data.array.lemmas
import util.data.fin
import util.data.list
import util.data.order
import util.meta.tactic

universe variables u₀ u₁ u₂
variables {α : Type u₀} {β β' : Type u₁} {γ : Type u₂}

open nat

namespace array

def push_aux {n : ℕ} (x : α) (ar : fin n → α) : fin (succ n) → α
  | ⟨0,_⟩ := x
  | ⟨succ i,P⟩ := ar ⟨i,lt_of_succ_lt_succ P⟩

def push {n : ℕ} (x : α) : array n α → array (succ n) α
  | ⟨ ar ⟩ := ⟨ push_aux x ar ⟩

def pop {n : ℕ} : array (succ n) α → array n α
  | ⟨ ar ⟩ := ⟨ ar ∘ fin.succ ⟩

def head {n : ℕ} : array (succ n) α → α
  | ⟨ ar ⟩ := ar 0

lemma push_head_pop {n : ℕ} (xs : array (succ n) α)
: push (head xs) (pop xs) = xs := sorry

open d_array -- (rev_iterate_aux rev_iterate)
lemma rev_iterate_push {n : ℕ}
  (x : α) (xs : array n α)
  (i : β)
  (f : fin (succ n) → α → β → β)
: rev_iterate (push x xs) i f = f 0 x (rev_iterate xs i (f ∘ fin.succ)) :=
begin
  revert x xs,
  induction n with n IH ; intros x xs,
  { cases xs with xs, refl, },
  { rw [← push_head_pop xs,IH],
    unfold function.comp,
    rw [push_head_pop xs],
    admit }
end

def maximum_aux {n : ℕ} (a : array n ℕ) (i : ℕ) (H : i ≤ n) : ℕ :=
d_array.iterate_aux a (λ _, max) i H 0

lemma le_maximum_aux {n : ℕ} (a : array n ℕ) (k : ℕ) (Hk : k ≤ n)
  (i  : fin n)
  (Hi : i.val < k)
: a.read i ≤ maximum_aux a k Hk :=
begin
  induction k,
  case nat.zero { admit },
  case nat.succ : k
  { unfold maximum_aux iterate_aux,
    simp, admit },
end

def maximum {n : ℕ} (a : array n ℕ) : ℕ :=
maximum_aux a n (by refl)

lemma le_maximum {n : ℕ} (a : array n ℕ) (i : fin n)
: a.read i ≤ maximum a :=
begin
  apply le_maximum_aux,
  apply i.is_lt
end

lemma rev_list_eq_nil (ar : array 0 α)
: ar.rev_list = [] :=
by refl

lemma to_list_eq_nil (ar : array 0 α)
: ar.to_list = [] :=
by refl

lemma iterate_aux_pop {n : ℕ} (ar : array (succ n) α)
  (f : fin (succ n) → α → β → β) (x : β)
  {k : ℕ}
  (Hk : k ≤ n)
: iterate_aux ar f (succ k) (succ_le_succ Hk) x
= iterate_aux (pop ar) (f ∘ fin.succ) k Hk (f 0 (ar.read 0) x) :=
begin
  induction k,
  case zero
    { refl },
  case succ : k
    { rw d_array.iterate_aux.equations._eqn_2 (pop ar), simp,
      rw ← k_ih, unfold iterate_aux, simp,
      apply congr_fun,
      cases ar, refl }
end

lemma rev_list_eq_cons_aux {n k : ℕ} (ar : array n α) (xs : list α)
  (H : k ≤ n)
: iterate_aux ar (λ _, list.cons) k H xs =
      iterate_aux ar (λ _, list.cons) k H [] ++ xs :=
begin
  induction k,
  { unfold iterate_aux, simp },
  { unfold iterate_aux, simp [k_ih], },
end

lemma rev_list_eq_cons {n : ℕ} (ar : array (succ n) α)
: ar.rev_list = ar.pop.rev_list ++ [ar.read 0] :=
begin
  unfold rev_list foldl iterate d_array.iterate,
  rw [iterate_aux_pop _ _ _ (le_refl n),rev_list_eq_cons_aux],
end

lemma iterate_aux_pop_back {n : ℕ} (ar : array (succ n) α)
  (f : fin (succ n) → α → β → β) (x : β)
  (k : ℕ)
  (Hk : k ≤ n)
: iterate_aux ar f k (le_succ_of_le Hk) x = iterate_aux (pop_back ar) (restr f) k Hk x :=
begin
  induction k,
  case zero
    { refl },
  case succ : k
    { unfold iterate_aux, simp,
      apply congr_arg,
      apply k_ih },
end

lemma rev_list_eq_append {n : ℕ} (ar : array (succ n) α)
: ar.rev_list = ar.read fin.max :: ar.pop_back.rev_list :=
begin
  unfold rev_list foldl iterate d_array.iterate iterate_aux,
  simp, split, refl,
  apply iterate_aux_pop_back,
end

end array

lemma fin.sum_zero
  [has_add α] [has_zero α]
  (f : fin 0 → α)
: fin.sum 0 f = 0 :=
rfl
open array
lemma fin.sum_succ {n : ℕ}
  [add_comm_monoid α]
  (f : fin (succ n) → α)
: fin.sum (succ n) f = fin.sum n (f ∘ fin.succ) + f 0 :=
begin
  unfold fin.sum fin.foldl,
  repeat { rw [← rev_list_foldr] },
  simp! [d_array.foldl,array.rev_list_eq_cons,d_array.iterate,d_array.iterate_aux
        ,d_array.read,d_array.data,array.pop],
  symmetry,
  simp [list.foldr_hom (has_add.add (f 0)) _ has_add.add], refl,
end

@[simp]
lemma array_widen_eq_pop_back {n : ℕ} (f : fin (succ n) → α)
: d_array.mk (f ∘ widen) = array.pop_back ⟨f⟩ :=
begin
  ext1, cases i, refl,
end

attribute [extensionality] d_array.ext'

lemma push_pop_back {n : ℕ} (ar : array n.succ α) :
  push_back (pop_back ar) (ar.read fin.max) = ar :=
by { ext ⟨i,h⟩, cases ar, simp! only [d_array.read,array.read,push_back,pop_back],
     split_ifs; [subst i, skip]; refl }

open list

lemma fin.sum_succ' {n : ℕ}
  [add_comm_monoid α]
  (f : fin (succ n) → α)
: fin.sum (succ n) f = fin.sum n (f ∘ widen) + f fin.max :=
begin
  unfold fin.sum fin.foldl,
  rw [← to_list_foldl,← to_list_foldl, ← push_pop_back ⟨f⟩, push_back_to_list, ← array_widen_eq_pop_back],
  simp [array.read,d_array.read],
end


--  An abstract formalization of "isomorphism is equality up to relabeling"
-- -------------------------------------------------------------------------
--
-- See `README.md` for more info.
--
-- This file contains collections of category-theoretic axioms that are parameterized in such a way that
-- they are suitable for all kinds of categories, groupoids, and higher groupoids.
--
-- Several instances of these axioms can be constructed from basic structures provided by Lean (i.e. Core
-- and a tiny bit of mathlib). These can be found in `Instances.lean`.

import Structure.Generic.Axioms.Universes
import Structure.Generic.Axioms.AbstractFunctors
import Structure.Generic.Axioms.AbstractEquivalences
import Structure.Generic.Axioms.GeneralizedProperties
import Structure.Generic.Axioms.DependentGeneralizedProperties
import Structure.Generic.Axioms.InstanceEquivalences

open GeneralizedRelation
open GeneralizedDependentRelation

set_option autoBoundImplicitLocal false
--set_option pp.universes true

-- TODO: Add equivalences.
-- TODO: Add (iso)morphisms as an additional type class.

namespace HasLinearFunOp

  variable (U : Universe) [h : HasInternalFunctors U] [HasLinearFunOp U]

  instance : HasRefl    h.Fun := ⟨idFun⟩
  instance : HasTrans   h.Fun := ⟨compFunFunFun _ _ _⟩
  instance : IsPreorder h.Fun := ⟨⟩

  instance hasArrows : HasArrows ⌈U⌉ U := ⟨h.Fun⟩

  @[simp] theorem transDef {α β γ : U} {F : α ⟶ β} {G : β ⟶ γ} : G • F = G ⊙ F :=
  compFunFunFun.effEff α β γ F G

  variable [hInst : HasNaturalEquivalences U] [HasLinearFunOp hInst.equivUniverse]

  def DependentArrow {α β : U} (F : α ⟶ β) (a : α) (b : β) := F a ≃ b

  namespace DependentArrow

    def refl {α : U} (a : α) : (idFun α) a ≃ a :=
    Eq.ndrec (motive := λ x : α => ⌈x ≃ a⌉) (ident (hInst.Equiv α) a) (Eq.symm (idFun.eff α a))

    def trans {α β γ : U} {F : α ⟶ β} {G : β ⟶ γ} {a : α} {b : β} {c : γ} : F a ≃ b ⟶ G b ≃ c ⟶ (G • F) a ≃ c :=
    let f₁ : F a ≃ b ⟶ (G • F) a ≃ G b := compFunFunFun.effEffEff α β γ F G a ▸ HasEquivCongrArg.equiv_congrArg U G;
    HasTrans.trans ⊙ f₁

    instance : HasDependentRefl    (DependentArrow U) := ⟨refl  U⟩
    instance : HasDependentTrans   (DependentArrow U) := ⟨trans U⟩
    instance : IsDependentPreorder (DependentArrow U) := ⟨⟩

  end DependentArrow

  instance hasDependentArrows : HasDependentArrows U U hInst.equivUniverse := ⟨DependentArrow U⟩

end HasLinearFunOp


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

Theory of topological rings with uniform structure.
-/
import topology.algebra.group_completion
import topology.algebra.ring

open classical set filter topological_space add_comm_group
open_locale classical
noncomputable theory

namespace uniform_space.completion
open dense_inducing uniform_space function
variables (α : Type*) [ring α] [uniform_space α]

instance : has_one (completion α) := ⟨(1:α)⟩

instance : has_mul (completion α) :=
  ⟨curry $ (dense_inducing_coe.prod dense_inducing_coe).extend (coe ∘ uncurry (*))⟩

@[norm_cast] lemma coe_one : ((1 : α) : completion α) = 1 := rfl

variables {α} [topological_ring α]

@[norm_cast]
lemma coe_mul (a b : α) : ((a * b : α) : completion α) = a * b :=
((dense_inducing_coe.prod dense_inducing_coe).extend_eq
  ((continuous_coe α).comp (@continuous_mul α _ _ _)) (a, b)).symm

variables [uniform_add_group α]

lemma continuous_mul : continuous (λ p : completion α × completion α, p.1 * p.2) :=
begin
  haveI : is_Z_bilin ((coe ∘ uncurry (*)) : α × α → completion α) :=
  { add_left := begin
      introv,
      change coe ((a + a')*b) = coe (a*b) + coe (a'*b),
      rw_mod_cast add_mul
    end,
    add_right := begin
      introv,
      change coe (a*(b + b')) = coe (a*b) + coe (a*b'),
      rw_mod_cast mul_add
    end },
  have : continuous ((coe ∘ uncurry (*)) : α × α → completion α),
    from (continuous_coe α).comp continuous_mul,
  convert dense_inducing_coe.extend_Z_bilin dense_inducing_coe this,
  simp only [(*), curry, prod.mk.eta]
end

lemma continuous.mul {β : Type*} [topological_space β] {f g : β → completion α}
  (hf : continuous f) (hg : continuous g) : continuous (λb, f b * g b) :=
continuous_mul.comp (hf.prod_mk hg : _)

instance : ring (completion α) :=
{ one_mul       := assume a, completion.induction_on a
    (is_closed_eq (continuous.mul continuous_const continuous_id) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, one_mul]),
  mul_one       := assume a, completion.induction_on a
    (is_closed_eq (continuous.mul continuous_id continuous_const) continuous_id)
    (assume a, by rw [← coe_one, ← coe_mul, mul_one]),
  mul_assoc     := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul (continuous.mul continuous_fst (continuous_fst.comp continuous_snd))
        (continuous_snd.comp continuous_snd))
      (continuous.mul continuous_fst
        (continuous.mul (continuous_fst.comp continuous_snd) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_mul, ← coe_mul, ← coe_mul, ← coe_mul, mul_assoc]),
  left_distrib  := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul continuous_fst (continuous.add
        (continuous_fst.comp continuous_snd)
        (continuous_snd.comp continuous_snd)))
      (continuous.add
        (continuous.mul continuous_fst (continuous_fst.comp continuous_snd))
        (continuous.mul continuous_fst (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, mul_add]),
  right_distrib := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous.mul (continuous.add continuous_fst
        (continuous_fst.comp continuous_snd)) (continuous_snd.comp continuous_snd))
      (continuous.add
        (continuous.mul continuous_fst (continuous_snd.comp continuous_snd))
        (continuous.mul (continuous_fst.comp continuous_snd) (continuous_snd.comp continuous_snd))))
    (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, add_mul]),
  ..completion.add_comm_group, ..completion.has_mul α, ..completion.has_one α }

/-- The map from a uniform ring to its completion, as a ring homomorphism. -/
def coe_ring_hom : α →+* completion α :=
⟨coe, coe_one α, assume a b, coe_mul a b, coe_zero, assume a b, coe_add a b⟩

universes u
variables {β : Type u} [uniform_space β] [ring β] [uniform_add_group β] [topological_ring β]
          (f : α →+* β) (hf : continuous f)

/-- The completion extension as a ring morphism. -/
def extension_hom [complete_space β] [separated_space β] :
  completion α →+* β :=
have hf : uniform_continuous f, from uniform_continuous_of_continuous hf,
{ to_fun := completion.extension f,
  map_zero' := by rw [← coe_zero, extension_coe hf, f.map_zero],
  map_add' := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      (continuous_extension.comp continuous_add)
      ((continuous_extension.comp continuous_fst).add
                      (continuous_extension.comp continuous_snd)))
    (assume a b,
      by rw [← coe_add, extension_coe hf, extension_coe hf, extension_coe hf,
             f.map_add]),
  map_one' := by rw [← coe_one, extension_coe hf, f.map_one],
  map_mul' := assume a b, completion.induction_on₂ a b
    (is_closed_eq
      (continuous_extension.comp continuous_mul)
      ((continuous_extension.comp continuous_fst).mul (continuous_extension.comp continuous_snd)))
    (assume a b,
      by rw [← coe_mul, extension_coe hf, extension_coe hf, extension_coe hf, f.map_mul]) }

instance top_ring_compl : topological_ring (completion α) :=
{ continuous_add := continuous_add,
  continuous_mul := continuous_mul,
  continuous_neg := continuous_neg }

/-- The completion map as a ring morphism. -/
def map_ring_hom : completion α →+* completion β :=
  extension_hom (coe_ring_hom.comp f) ((continuous_coe β).comp hf)

variables (R : Type*) [comm_ring R] [uniform_space R] [uniform_add_group R] [topological_ring R]

instance : comm_ring (completion R) :=
{ mul_comm := assume a b, completion.induction_on₂ a b
      (is_closed_eq (continuous_fst.mul continuous_snd)
                    (continuous_snd.mul continuous_fst))
      (assume a b, by rw [← coe_mul, ← coe_mul, mul_comm]),
 ..completion.ring }

end uniform_space.completion

namespace uniform_space
variables {α : Type*}
lemma ring_sep_rel (α) [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  separation_setoid α = submodule.quotient_rel (ideal.closure ⊥) :=
setoid.ext $ assume x y, group_separation_rel x y

lemma ring_sep_quot
  (α) [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) = (⊥ : ideal α).closure.quotient :=
by rw [@ring_sep_rel α r]; refl

/-- Given a topological ring `α` equipped with a uniform structure that makes subtraction uniformly
continuous, get an equivalence between the separated quotient of `α` and the quotient ring
corresponding to the closure of zero. -/
def sep_quot_equiv_ring_quot (α)
  [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  quotient (separation_setoid α) ≃ (⊥ : ideal α).closure.quotient :=
quotient.congr_right $ assume x y, group_separation_rel x y

/- TODO: use a form of transport a.k.a. lift definition a.k.a. transfer -/
instance comm_ring [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  comm_ring (quotient (separation_setoid α)) :=
by rw ring_sep_quot α; apply_instance

instance topological_ring
  [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] :
  topological_ring (quotient (separation_setoid α)) :=
begin
  convert topological_ring_quotient (⊥ : ideal α).closure; try {apply ring_sep_rel},
  simp [uniform_space.comm_ring]
end

end uniform_space