/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import algebraic_geometry.projective_spectrum.structure_sheaf
import algebraic_geometry.Spec

/-!
# Proj as a scheme

This file is to prove that `Proj` is a scheme.

## Notation

* `Proj`      : `Proj` as a locally ringed space
* `Proj.T`    : the underlying topological space of `Proj`
* `Proj| U`   : `Proj` restricted to some open set `U`
* `Proj.T| U` : the underlying topological space of `Proj` restricted to open set `U`
* `pbo f`     : basic open set at `f` in `Proj`
* `Spec`      : `Spec` as a locally ringed space
* `Spec.T`    : the underlying topological space of `Spec`
* `sbo g`     : basic open set at `g` in `Spec`
* `A⁰_x`       : the degree zero part of localized ring `Aₓ`

## Implementation

In `src/algebraic_geometry/projective_spectrum/structure_sheaf.lean`, we have given `Proj` a
structure sheaf so that `Proj` is a locally ringed space. In this file we will prove that `Proj`
equipped with this structure sheaf is a scheme. We achieve this by using an affine cover by basic
open sets in `Proj`, more specifically:

1. We prove that `Proj` can be covered by basic open sets at homogeneous element of positive degree.
2. We prove that for any `f : A`, `Proj.T | (pbo f)` is homeomorphic to `Spec.T A⁰_f`:
  - forward direction :
    for any `x : pbo f`, i.e. a relevant homogeneous prime ideal `x`, send it to
    `x ∩ span {g / 1 | g ∈ A}` (see `Top_component.forward.carrier`). This ideal is prime, the proof
    is in `Top_component.forward.to_fun`. The fact that this function is continuous is found in
    `Top_component.forward`
  - backward direction : TBC

## Main Definitions and Statements

* `degree_zero_part`: the degree zero part of the localized ring `Aₓ` where `x` is a homogeneous
  element of degree `n` is the subring of elements of the form `a/f^m` where `a` has degree `mn`.

For a homogeneous element `f` of degree `n`
* `Top_component.forward`: `forward f` is the
  continuous map between `Proj.T| pbo f` and `Spec.T A⁰_f`
* `Top_component.forward.preimage_eq`: for any `a: A`, if `a/f^m` has degree zero, then the preimage
  of `sbo a/f^m` under `forward f` is `pbo f ∩ pbo a`.

* [Robin Hartshorne, *Algebraic Geometry*][Har77]: Chapter II.2 Proposition 2.5
-/

noncomputable theory

namespace algebraic_geometry

open_locale direct_sum big_operators pointwise big_operators
open direct_sum set_like.graded_monoid localization finset (hiding mk_zero)

variables {R A : Type*}
variables [comm_ring R] [comm_ring A] [algebra R A]

variables (𝒜 : ℕ → submodule R A)
variables [graded_algebra 𝒜]

open Top topological_space
open category_theory opposite
open projective_spectrum.structure_sheaf

local notation `Proj` := Proj.to_LocallyRingedSpace 𝒜
-- `Proj` as a locally ringed space
local notation `Proj.T` := Proj .1.1.1
-- the underlying topological space of `Proj`
local notation `Proj| ` U := Proj .restrict (opens.open_embedding (U : opens Proj.T))
-- `Proj` restrict to some open set
local notation `Proj.T| ` U :=
  (Proj .restrict (opens.open_embedding (U : opens Proj.T))).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Proj` restricted to some open set
local notation `pbo` x := projective_spectrum.basic_open 𝒜 x
-- basic open sets in `Proj`
local notation `sbo` f := prime_spectrum.basic_open f
-- basic open sets in `Spec`
local notation `Spec` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring)
-- `Spec` as a locally ringed space
local notation `Spec.T` ring :=
  (Spec.LocallyRingedSpace_obj (CommRing.of ring)).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Spec`

section
variable {𝒜}
/--
The degree zero part of the localized ring `Aₓ` is the subring of elements of the form `a/x^n` such
that `a` and `x^n` have the same degree.
-/
def degree_zero_part {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) : subring (away f) :=
{ carrier := { y | ∃ (n : ℕ) (a : 𝒜 (m * n)), y = mk a.1 ⟨f^n, ⟨n, rfl⟩⟩ },
  mul_mem' := λ _ _ ⟨n, ⟨a, h⟩⟩ ⟨n', ⟨b, h'⟩⟩, h.symm ▸ h'.symm ▸
    ⟨n+n', ⟨⟨a.1 * b.1, (mul_add m n n').symm ▸ mul_mem a.2 b.2⟩,
    by {rw mk_mul, congr' 1, simp only [pow_add], refl }⟩⟩,
  one_mem' := ⟨0, ⟨1, (mul_zero m).symm ▸ one_mem⟩,
    by { symmetry, convert ← mk_self 1, simp only [pow_zero], refl, }⟩,
  add_mem' := λ _ _ ⟨n, ⟨a, h⟩⟩ ⟨n', ⟨b, h'⟩⟩, h.symm ▸ h'.symm ▸
    ⟨n+n', ⟨⟨f ^ n * b.1 + f ^ n' * a.1, (mul_add m n n').symm ▸
      add_mem (mul_mem (by { rw mul_comm, exact set_like.graded_monoid.pow_mem n f_deg }) b.2)
        begin
          rw add_comm,
          refine mul_mem _ a.2,
          rw mul_comm,
          exact set_like.graded_monoid.pow_mem _ f_deg
        end⟩, begin
          rw add_mk,
          congr' 1,
          simp only [pow_add],
          refl,
        end⟩⟩,
  zero_mem' := ⟨0, ⟨0, (mk_zero _).symm⟩⟩,
  neg_mem' := λ x ⟨n, ⟨a, h⟩⟩, h.symm ▸ ⟨n, ⟨-a, neg_mk _ _⟩⟩ }

local notation `A⁰_` f_deg := degree_zero_part f_deg

instance (f : A) {m : ℕ} (f_deg : f ∈ 𝒜 m) : comm_ring (degree_zero_part f_deg) :=
(degree_zero_part f_deg).to_comm_ring

/--
Every element in the degree zero part of `Aₓ` can be written as `a/x^n` for some `a` and `n : ℕ`,
`degree_zero_part.deg` picks this natural number `n`
-/
def degree_zero_part.deg {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : ℕ :=
x.2.some

/--
Every element in the degree zero part of `Aₓ` can be written as `a/x^n` for some `a` and `n : ℕ`,
`degree_zero_part.deg` picks the numerator `a`
-/
def degree_zero_part.num {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : A :=
x.2.some_spec.some.1

lemma degree_zero_part.num_mem {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) :
  degree_zero_part.num f_deg x ∈ 𝒜 (m * degree_zero_part.deg f_deg x) :=
x.2.some_spec.some.2

lemma degree_zero_part.eq {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) :
  x.1 = mk (degree_zero_part.num f_deg x) ⟨f^(degree_zero_part.deg f_deg x), ⟨_, rfl⟩⟩ :=
x.2.some_spec.some_spec

lemma degree_zero_part.mul_val {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x y : A⁰_ f_deg) :
  (x * y).1 = x.1 * y.1 := rfl

end

end algebraic_geometry


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

! This file was ported from Lean 3 source module analysis.normed_space.mazur_ulam
! leanprover-community/mathlib commit 78261225eb5cedc61c5c74ecb44e5b385d13b733
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Instances.RealVectorSpace
import Mathbin.Analysis.NormedSpace.AffineIsometry

/-!
# Mazur-Ulam Theorem

Mazur-Ulam theorem states that an isometric bijection between two normed affine spaces over `ℝ` is
affine. We formalize it in three definitions:

* `isometry_equiv.to_real_linear_isometry_equiv_of_map_zero` : given `E ≃ᵢ F` sending `0` to `0`,
  returns `E ≃ₗᵢ[ℝ] F` with the same `to_fun` and `inv_fun`;
* `isometry_equiv.to_real_linear_isometry_equiv` : given `f : E ≃ᵢ F`, returns a linear isometry
  equivalence `g : E ≃ₗᵢ[ℝ] F` with `g x = f x - f 0`.
* `isometry_equiv.to_real_affine_isometry_equiv` : given `f : PE ≃ᵢ PF`, returns an affine isometry
  equivalence `g : PE ≃ᵃⁱ[ℝ] PF` whose underlying `isometry_equiv` is `f`

The formalization is based on [Jussi Väisälä, *A Proof of the Mazur-Ulam Theorem*][Vaisala_2003].

## Tags

isometry, affine map, linear map
-/

variable {E PE F PF : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [MetricSpace PE]
  [NormedAddTorsor E PE] [NormedAddCommGroup F] [NormedSpace ℝ F] [MetricSpace PF]
  [NormedAddTorsor F PF]

open Set AffineMap AffineIsometryEquiv

noncomputable section

namespace IsometryEquiv

include E

/-- If an isometric self-homeomorphism of a normed vector space over `ℝ` fixes `x` and `y`,
then it fixes the midpoint of `[x, y]`. This is a lemma for a more general Mazur-Ulam theorem,
see below. -/
theorem midpoint_fixed {x y : PE} :
    ∀ e : PE ≃ᵢ PE, e x = x → e y = y → e (midpoint ℝ x y) = midpoint ℝ x y :=
  by
  set z := midpoint ℝ x y
  -- Consider the set of `e : E ≃ᵢ E` such that `e x = x` and `e y = y`
  set s := { e : PE ≃ᵢ PE | e x = x ∧ e y = y }
  haveI : Nonempty s := ⟨⟨IsometryEquiv.refl PE, rfl, rfl⟩⟩
  -- On the one hand, `e` cannot send the midpoint `z` of `[x, y]` too far
  have h_bdd : BddAbove (range fun e : s => dist (e z) z) :=
    by
    refine' ⟨dist x z + dist x z, forall_range_iff.2 <| Subtype.forall.2 _⟩
    rintro e ⟨hx, hy⟩
    calc
      dist (e z) z ≤ dist (e z) x + dist x z := dist_triangle (e z) x z
      _ = dist (e x) (e z) + dist x z := by rw [hx, dist_comm]
      _ = dist x z + dist x z := by erw [e.dist_eq x z]

  -- On the other hand, consider the map `f : (E ≃ᵢ E) → (E ≃ᵢ E)`
  -- sending each `e` to `R ∘ e⁻¹ ∘ R ∘ e`, where `R` is the point reflection in the
  -- midpoint `z` of `[x, y]`.
  set R : PE ≃ᵢ PE := (point_reflection ℝ z).toIsometryEquiv
  set f : PE ≃ᵢ PE → PE ≃ᵢ PE := fun e => ((e.trans R).trans e.symm).trans R
  -- Note that `f` doubles the value of ``dist (e z) z`
  have hf_dist : ∀ e, dist (f e z) z = 2 * dist (e z) z :=
    by
    intro e
    dsimp [f]
    rw [dist_point_reflection_fixed, ← e.dist_eq, e.apply_symm_apply,
      dist_point_reflection_self_real, dist_comm]
  -- Also note that `f` maps `s` to itself
  have hf_maps_to : maps_to f s s := by
    rintro e ⟨hx, hy⟩
    constructor <;> simp [hx, hy, e.symm_apply_eq.2 hx.symm, e.symm_apply_eq.2 hy.symm]
  -- Therefore, `dist (e z) z = 0` for all `e ∈ s`.
  set c := ⨆ e : s, dist ((e : PE ≃ᵢ PE) z) z
  have : c ≤ c / 2 := by
    apply csupᵢ_le
    rintro ⟨e, he⟩
    simp only [Subtype.coe_mk, le_div_iff' (zero_lt_two' ℝ), ← hf_dist]
    exact le_csupᵢ h_bdd ⟨f e, hf_maps_to he⟩
  replace : c ≤ 0
  · linarith
  refine' fun e hx hy => dist_le_zero.1 (le_trans _ this)
  exact le_csupᵢ h_bdd ⟨e, hx, hy⟩
#align isometry_equiv.midpoint_fixed IsometryEquiv.midpoint_fixed

include F

/-- A bijective isometry sends midpoints to midpoints. -/
theorem map_midpoint (f : PE ≃ᵢ PF) (x y : PE) : f (midpoint ℝ x y) = midpoint ℝ (f x) (f y) :=
  by
  set e : PE ≃ᵢ PE :=
    ((f.trans <| (point_reflection ℝ <| midpoint ℝ (f x) (f y)).toIsometryEquiv).trans f.symm).trans
      (point_reflection ℝ <| midpoint ℝ x y).toIsometryEquiv
  have hx : e x = x := by simp
  have hy : e y = y := by simp
  have hm := e.midpoint_fixed hx hy
  simp only [e, trans_apply] at hm
  rwa [← eq_symm_apply, to_isometry_equiv_symm, point_reflection_symm, coe_to_isometry_equiv,
    coe_to_isometry_equiv, point_reflection_self, symm_apply_eq, point_reflection_fixed_iff] at hm
#align isometry_equiv.map_midpoint IsometryEquiv.map_midpoint

/-!
Since `f : PE ≃ᵢ PF` sends midpoints to midpoints, it is an affine map.
We define a conversion to a `continuous_linear_equiv` first, then a conversion to an `affine_map`.
-/

/-- **Mazur-Ulam Theorem**: if `f` is an isometric bijection between two normed vector spaces
over `ℝ` and `f 0 = 0`, then `f` is a linear isometry equivalence. -/
def toRealLinearIsometryEquivOfMapZero (f : E ≃ᵢ F) (h0 : f 0 = 0) : E ≃ₗᵢ[ℝ] F :=
  { (AddMonoidHom.ofMapMidpoint ℝ ℝ f h0 f.map_midpoint).toRealLinearMap f.Continuous, f with
    norm_map' := fun x => show ‖f x‖ = ‖x‖ by simp only [← dist_zero_right, ← h0, f.dist_eq] }
#align isometry_equiv.to_real_linear_isometry_equiv_of_map_zero IsometryEquiv.toRealLinearIsometryEquivOfMapZero

@[simp]
theorem coe_to_real_linear_equiv_of_map_zero (f : E ≃ᵢ F) (h0 : f 0 = 0) :
    ⇑(f.toRealLinearIsometryEquivOfMapZero h0) = f :=
  rfl
#align isometry_equiv.coe_to_real_linear_equiv_of_map_zero IsometryEquiv.coe_to_real_linear_equiv_of_map_zero

@[simp]
theorem coe_to_real_linear_equiv_of_map_zero_symm (f : E ≃ᵢ F) (h0 : f 0 = 0) :
    ⇑(f.toRealLinearIsometryEquivOfMapZero h0).symm = f.symm :=
  rfl
#align isometry_equiv.coe_to_real_linear_equiv_of_map_zero_symm IsometryEquiv.coe_to_real_linear_equiv_of_map_zero_symm

/-- **Mazur-Ulam Theorem**: if `f` is an isometric bijection between two normed vector spaces
over `ℝ`, then `x ↦ f x - f 0` is a linear isometry equivalence. -/
def toRealLinearIsometryEquiv (f : E ≃ᵢ F) : E ≃ₗᵢ[ℝ] F :=
  (f.trans (IsometryEquiv.addRight (f 0)).symm).toRealLinearIsometryEquivOfMapZero
    (by simpa only [sub_eq_add_neg] using sub_self (f 0))
#align isometry_equiv.to_real_linear_isometry_equiv IsometryEquiv.toRealLinearIsometryEquiv

@[simp]
theorem to_real_linear_equiv_apply (f : E ≃ᵢ F) (x : E) :
    (f.toRealLinearIsometryEquiv : E → F) x = f x - f 0 :=
  (sub_eq_add_neg (f x) (f 0)).symm
#align isometry_equiv.to_real_linear_equiv_apply IsometryEquiv.to_real_linear_equiv_apply

@[simp]
theorem toRealLinearIsometryEquiv_symm_apply (f : E ≃ᵢ F) (y : F) :
    (f.toRealLinearIsometryEquiv.symm : F → E) y = f.symm (y + f 0) :=
  rfl
#align isometry_equiv.to_real_linear_isometry_equiv_symm_apply IsometryEquiv.toRealLinearIsometryEquiv_symm_apply

/-- **Mazur-Ulam Theorem**: if `f` is an isometric bijection between two normed add-torsors over
normed vector spaces over `ℝ`, then `f` is an affine isometry equivalence. -/
def toRealAffineIsometryEquiv (f : PE ≃ᵢ PF) : PE ≃ᵃⁱ[ℝ] PF :=
  AffineIsometryEquiv.mk' f
    ((vaddConst (Classical.arbitrary PE)).trans <|
        f.trans (vaddConst (f <| Classical.arbitrary PE)).symm).toRealLinearIsometryEquiv
    (Classical.arbitrary PE) fun p => by simp
#align isometry_equiv.to_real_affine_isometry_equiv IsometryEquiv.toRealAffineIsometryEquiv

@[simp]
theorem coeFn_toRealAffineIsometryEquiv (f : PE ≃ᵢ PF) : ⇑f.toRealAffineIsometryEquiv = f :=
  rfl
#align isometry_equiv.coe_fn_to_real_affine_isometry_equiv IsometryEquiv.coeFn_toRealAffineIsometryEquiv

@[simp]
theorem coe_toRealAffineIsometryEquiv (f : PE ≃ᵢ PF) :
    f.toRealAffineIsometryEquiv.toIsometryEquiv = f :=
  by
  ext
  rfl
#align isometry_equiv.coe_to_real_affine_isometry_equiv IsometryEquiv.coe_toRealAffineIsometryEquiv

end IsometryEquiv


import game.limits.bounded_if_convergent
import game.limits.Blockus_time
import game.sets.L01defs
import game.sup_inf.GLBprop_if_LUBprop
import data.real.basic
import game.limits.Lemmas -- hide
import tactic.linarith

namespace xena -- hide

/-
# Chapter 7 : Limits

## Level 11

As you can tell by the name of this lemma this proof is really annoying because it should be
so obvious but lean is not aware of it. It shouldn't be that hard to prove but you will likely
use it in lim_recip.
-/

lemma soul_sucking_deep_sadness {ε a : ℝ} (h : 0 < ε) (ha : a ≠ 0): (1 / a) * (a * ε) = ε :=
begin
simp, rw ← mul_assoc, rw inv_mul_cancel, linarith, exact ha,
end

end xena -- hide


/-
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, Yury Kudryashov
-/
import measure_theory.measure.measure_space_def

/-!
# Null measurable sets and complete measures

## Main definitions

### Null measurable sets and functions

A set `s : set α` is called *null measurable* (`measure_theory.null_measurable_set`) if it satisfies
any of the following equivalent conditions:

* there exists a measurable set `t` such that `s =ᵐ[μ] t` (this is used as a definition);
* `measure_theory.to_measurable μ s =ᵐ[μ] s`;
* there exists a measurable subset `t ⊆ s` such that `t =ᵐ[μ] s` (in this case the latter equality
  means that `μ (s \ t) = 0`);
* `s` can be represented as a union of a measurable set and a set of measure zero;
* `s` can be represented as a difference of a measurable set and a set of measure zero.

Null measurable sets form a σ-algebra that is registered as a `measurable_space` instance on
`measure_theory.null_measurable_space α μ`. We also say that `f : α → β` is
`measure_theory.null_measurable` if the preimage of a measurable set is a null measurable set.
In other words, `f : α → β` is null measurable if it is measurable as a function
`measure_theory.null_measurable_space α μ → β`.

### Complete measures

We say that a measure `μ` is complete w.r.t. the `measurable_space α` σ-algebra (or the σ-algebra is
complete w.r.t measure `μ`) if every set of measure zero is measurable. In this case all null
measurable sets and functions are measurable.

For each measure `μ`, we define `measure_theory.measure.completion μ` to be the same measure
interpreted as a measure on `measure_theory.null_measurable_space α μ` and prove that this is a
complete measure.

## Implementation notes

We define `measure_theory.null_measurable_set` as `@measurable_set (null_measurable_space α μ) _` so
that theorems about `measurable_set`s like `measurable_set.union` can be applied to
`null_measurable_set`s. However, these lemmas output terms of the same form
`@measurable_set (null_measurable_space α μ) _ _`. While this is definitionally equal to the
expected output `null_measurable_set s μ`, it looks different and may be misleading. So we copy all
standard lemmas about measurable sets to the `measure_theory.null_measurable_set` namespace and fix
the output type.

## Tags

measurable, measure, null measurable, completion
-/

open filter set encodable

variables {ι α β γ : Type*}

namespace measure_theory

/-- A type tag for `α` with `measurable_set` given by `null_measurable_set`. -/
@[nolint unused_arguments]
def null_measurable_space (α : Type*) [measurable_space α] (μ : measure α . volume_tac) : Type* := α

section

variables {m0 : measurable_space α} {μ : measure α} {s t : set α}

instance [h : inhabited α] : inhabited (null_measurable_space α μ) := h
instance [h : subsingleton α] : subsingleton (null_measurable_space α μ) := h

instance : measurable_space (null_measurable_space α μ) :=
{ measurable_set' := λ s, ∃ t, measurable_set t ∧ s =ᵐ[μ] t,
  measurable_set_empty := ⟨∅, measurable_set.empty, ae_eq_refl _⟩,
  measurable_set_compl := λ s ⟨t, htm, hts⟩, ⟨tᶜ, htm.compl, hts.compl⟩,
  measurable_set_Union := λ s hs, by { choose t htm hts using hs,
    exact ⟨⋃ i, t i, measurable_set.Union htm, eventually_eq.countable_Union hts⟩ } }

/-- A set is called `null_measurable_set` if it can be approximated by a measurable set up to
a set of null measure. -/
def null_measurable_set [measurable_space α] (s : set α) (μ : measure α . volume_tac) : Prop :=
@measurable_set (null_measurable_space α μ) _ s

@[simp] lemma _root_.measurable_set.null_measurable_set (h : measurable_set s) :
  null_measurable_set s μ :=
⟨s, h, ae_eq_refl _⟩

@[simp] lemma null_measurable_set_empty : null_measurable_set ∅ μ := measurable_set.empty

@[simp] lemma null_measurable_set_univ : null_measurable_set univ μ := measurable_set.univ

namespace null_measurable_set

lemma of_null (h : μ s = 0) : null_measurable_set s μ :=
⟨∅, measurable_set.empty, ae_eq_empty.2 h⟩

lemma compl (h : null_measurable_set s μ) : null_measurable_set sᶜ μ := h.compl

lemma of_compl (h : null_measurable_set sᶜ μ) : null_measurable_set s μ := h.of_compl

@[simp] lemma compl_iff : null_measurable_set sᶜ μ ↔ null_measurable_set s μ :=
measurable_set.compl_iff

@[nontriviality]
lemma of_subsingleton [subsingleton α] : null_measurable_set s μ := subsingleton.measurable_set

protected lemma congr (hs : null_measurable_set s μ) (h : s =ᵐ[μ] t) :
  null_measurable_set t μ :=
let ⟨s', hm, hs'⟩ := hs in ⟨s', hm, h.symm.trans hs'⟩

protected

protected lemma bUnion_decode₂ [encodable ι] ⦃f : ι → set α⦄ (h : ∀ i, null_measurable_set (f i) μ)
  (n : ℕ) : null_measurable_set (⋃ b ∈ encodable.decode₂ ι n, f b) μ :=
measurable_set.bUnion_decode₂ h n

protected lemma bUnion {f : ι → set α} {s : set ι} (hs : countable s)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋃ b ∈ s, f b) μ :=
measurable_set.bUnion hs h

protected lemma sUnion {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, null_measurable_set t μ) :
  null_measurable_set (⋃₀ s) μ :=
by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }

lemma Union_Prop {p : Prop} {f : p → set α} (hf : ∀ i, null_measurable_set (f i) μ) :
  null_measurable_set (⋃ i, f i) μ :=
measurable_set.Union_Prop hf

lemma Union_fintype [fintype ι] {f : ι → set α} (h : ∀ b, null_measurable_set (f b) μ) :
  null_measurable_set (⋃ b, f b) μ :=
measurable_set.Union_fintype h

protected lemma Inter [encodable ι] {f : ι → set α} (h : ∀ i, null_measurable_set (f i) μ) :
  null_measurable_set (⋂ i, f i) μ :=
measurable_set.Inter h

protected lemma bInter {f : β → set α} {s : set β} (hs : countable s)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
measurable_set.bInter hs h

protected lemma sInter {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, null_measurable_set t μ) :
  null_measurable_set (⋂₀ s) μ :=
measurable_set.sInter hs h

lemma Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, null_measurable_set (f b) μ) :
  null_measurable_set (⋂ b, f b) μ :=
measurable_set.Inter_Prop hf

lemma Inter_fintype [fintype ι] {f : ι → set α} (h : ∀ b, null_measurable_set (f b) μ) :
  null_measurable_set (⋂ b, f b) μ :=
measurable_set.Inter_fintype h

@[simp] protected lemma union (hs : null_measurable_set s μ) (ht : null_measurable_set t μ) :
  null_measurable_set (s ∪ t) μ :=
hs.union ht

protected lemma union_null (hs : null_measurable_set s μ) (ht : μ t = 0) :
  null_measurable_set (s ∪ t) μ :=
hs.union (of_null ht)

@[simp] protected lemma inter (hs : null_measurable_set s μ) (ht : null_measurable_set t μ) :
  null_measurable_set (s ∩ t) μ :=
hs.inter ht

@[simp] protected lemma diff (hs : null_measurable_set s μ) (ht : null_measurable_set t μ) :
  null_measurable_set (s \ t) μ :=
hs.diff ht

@[simp] protected lemma disjointed {f : ℕ → set α} (h : ∀ i, null_measurable_set (f i) μ) (n) :
  null_measurable_set (disjointed f n) μ :=
measurable_set.disjointed h n

@[simp] protected lemma const (p : Prop) : null_measurable_set {a : α | p} μ :=
measurable_set.const p

instance [measurable_singleton_class α] : measurable_singleton_class (null_measurable_space α μ) :=
⟨λ x, (@measurable_set_singleton α _ _ x).null_measurable_set⟩

protected lemma insert [measurable_singleton_class (null_measurable_space α μ)]
  (hs : null_measurable_set s μ) (a : α) :
  null_measurable_set (insert a s) μ :=
hs.insert a

lemma exists_measurable_superset_ae_eq (h : null_measurable_set s μ) :
  ∃ t ⊇ s, measurable_set t ∧ t =ᵐ[μ] s :=
begin
  rcases h with ⟨t, htm, hst⟩,
  refine ⟨t ∪ to_measurable μ (s \ t), _, htm.union (measurable_set_to_measurable _ _), _⟩,
  { exact diff_subset_iff.1 (subset_to_measurable _ _) },
  { have : to_measurable μ (s \ t) =ᵐ[μ] (∅ : set α), by simp [ae_le_set.1 hst.le],
    simpa only [union_empty] using hst.symm.union this }
end

lemma to_measurable_ae_eq (h : null_measurable_set s μ) :
  to_measurable μ s =ᵐ[μ] s :=
begin
  rw [to_measurable, dif_pos],
  exact h.exists_measurable_superset_ae_eq.some_spec.snd.2
end

lemma compl_to_measurable_compl_ae_eq (h : null_measurable_set s μ) :
  (to_measurable μ sᶜ)ᶜ =ᵐ[μ] s :=
by simpa only [compl_compl] using h.compl.to_measurable_ae_eq.compl

lemma exists_measurable_subset_ae_eq (h : null_measurable_set s μ) :
  ∃ t ⊆ s, measurable_set t ∧ t =ᵐ[μ] s :=
⟨(to_measurable μ sᶜ)ᶜ, compl_subset_comm.2 $ subset_to_measurable _ _,
  (measurable_set_to_measurable _ _).compl, h.compl_to_measurable_compl_ae_eq⟩

end null_measurable_set

lemma measure_Union {m0 : measurable_space α} {μ : measure α} [encodable ι] {f : ι → set α}
  (hn : pairwise (disjoint on f)) (h : ∀ i, measurable_set (f i)) :
  μ (⋃ i, f i) = ∑' i, μ (f i) :=
begin
  rw [measure_eq_extend (measurable_set.Union h),
    extend_Union measurable_set.empty _ measurable_set.Union _ hn h],
  { simp [measure_eq_extend, h] },
  { exact μ.empty },
  { exact μ.m_Union }
end

lemma measure_Union₀ [encodable ι] {f : ι → set α}
  (hn : pairwise (disjoint on f)) (h : ∀ i, null_measurable_set (f i) μ) :
  μ (⋃ i, f i) = ∑' i, μ (f i) :=
begin
  refine (measure_Union_le _).antisymm _,
  choose s hsf hsm hs_eq using λ i, (h i).exists_measurable_subset_ae_eq,
  have hsd : pairwise (disjoint on s), from hn.mono (λ i j h, h.mono (hsf i) (hsf j)),
  simp only [← measure_congr (hs_eq _), ← measure_Union hsd hsm],
  exact measure_mono (Union_subset_Union hsf)
end

lemma measure_union₀ (hs : null_measurable_set s μ) (ht : null_measurable_set t μ)
  (hd : disjoint s t) :
  μ (s ∪ t) = μ s + μ t :=
begin
  rw [union_eq_Union, measure_Union₀, tsum_fintype, fintype.sum_bool, cond, cond],
  exacts [pairwise_disjoint_on_bool.2 hd, λ b, bool.cases_on b ht hs]
end

section measurable_singleton_class

variable [measurable_singleton_class (null_measurable_space α μ)]

lemma null_measurable_set_singleton (x : α) : null_measurable_set {x} μ :=
measurable_set_singleton x

@[simp] lemma null_measurable_set_insert {a : α} {s : set α} :
  null_measurable_set (insert a s) μ ↔ null_measurable_set s μ :=
measurable_set_insert

lemma null_measurable_set_eq {a : α} : null_measurable_set {x | x = a} μ :=
null_measurable_set_singleton a

protected lemma _root_.set.finite.null_measurable_set (hs : finite s) : null_measurable_set s μ :=
finite.measurable_set hs

protected lemma _root_.finset.null_measurable_set (s : finset α) : null_measurable_set ↑s μ :=
finset.measurable_set s

end measurable_singleton_class

lemma _root_.set.finite.null_measurable_set_bUnion {f : ι → set α} {s : set ι} (hs : finite s)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) :
  null_measurable_set (⋃ b ∈ s, f b) μ :=
finite.measurable_set_bUnion hs h

lemma _root_.finset.null_measurable_set_bUnion {f : ι → set α} (s : finset ι)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) :
  null_measurable_set (⋃ b ∈ s, f b) μ :=
finset.measurable_set_bUnion s h

lemma _root_.set.finite.null_measurable_set_sUnion {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, null_measurable_set t μ) :
  null_measurable_set (⋃₀ s) μ :=
finite.measurable_set_sUnion hs h

lemma _root_.set.finite.null_measurable_set_bInter {f : ι → set α} {s : set ι} (hs : finite s)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
finite.measurable_set_bInter hs h

lemma _root_.finset.null_measurable_set_bInter {f : ι → set α} (s : finset ι)
  (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
s.finite_to_set.null_measurable_set_bInter h

lemma _root_.set.finite.null_measurable_set_sInter {s : set (set α)} (hs : finite s)
  (h : ∀ t ∈ s, null_measurable_set t μ) : null_measurable_set (⋂₀ s) μ :=
null_measurable_set.sInter hs.countable h

lemma null_measurable_set_to_measurable : null_measurable_set (to_measurable μ s) μ :=
(measurable_set_to_measurable _ _).null_measurable_set

end

section null_measurable

variables [measurable_space α] [measurable_space β] [measurable_space γ]
  {f : α → β} {μ : measure α}

/-- A function `f : α → β` is null measurable if the preimage of a measurable set is a null
measurable set. -/
def null_measurable (f : α → β) (μ : measure α . volume_tac) : Prop :=
∀ ⦃s : set β⦄, measurable_set s → null_measurable_set (f ⁻¹' s) μ

protected lemma _root_.measurable.null_measurable (h : measurable f) : null_measurable f μ :=
λ s hs, (h hs).null_measurable_set

protected lemma null_measurable.measurable' (h : null_measurable f μ) :
  @measurable (null_measurable_space α μ) β _ _ f := h

lemma measurable.comp_null_measurable {g : β → γ} (hg : measurable g)
  (hf : null_measurable f μ) : null_measurable (g ∘ f) μ :=
hg.comp hf

lemma null_measurable.congr {g : α → β} (hf : null_measurable f μ) (hg : f =ᵐ[μ] g) :
  null_measurable g μ :=
λ s hs, (hf hs).congr $ eventually_eq_set.2 $ hg.mono $
  λ x hx, by rw [mem_preimage, mem_preimage, hx]

end null_measurable

section is_complete

/-- A measure is complete if every null set is also measurable.
  A null set is a subset of a measurable set with measure `0`.
  Since every measure is defined as a special case of an outer measure, we can more simply state
  that a set `s` is null if `μ s = 0`. -/
class measure.is_complete {_ : measurable_space α} (μ : measure α) : Prop :=
(out' : ∀ s, μ s = 0 → measurable_set s)

variables {m0 : measurable_space α} {μ : measure α} {s t : set α}

theorem measure.is_complete_iff :
  μ.is_complete ↔ ∀ s, μ s = 0 → measurable_set s := ⟨λ h, h.1, λ h, ⟨h⟩⟩
theorem measure.is_complete.out (h : μ.is_complete) :
  ∀ s, μ s = 0 → measurable_set s := h.1

theorem measurable_set_of_null [μ.is_complete] (hs : μ s = 0) : measurable_set s :=
measure_theory.measure.is_complete.out' s hs

theorem null_measurable_set.measurable_of_complete (hs : null_measurable_set s μ) [μ.is_complete] :
  measurable_set s :=
diff_diff_cancel_left (subset_to_measurable μ s) ▸ (measurable_set_to_measurable _ _).diff
  (measurable_set_of_null (ae_le_set.1 hs.to_measurable_ae_eq.le))

theorem null_measurable.measurable_of_complete [μ.is_complete] {m1 : measurable_space β} {f : α → β}
  (hf : null_measurable f μ) : measurable f :=
λ s hs, (hf hs).measurable_of_complete

lemma _root_.measurable.congr_ae {α β} [measurable_space α] [measurable_space β] {μ : measure α}
  [hμ : μ.is_complete] {f g : α → β} (hf : measurable f) (hfg : f =ᵐ[μ] g) :
  measurable g :=
(hf.null_measurable.congr hfg).measurable_of_complete

namespace measure

/-- Given a measure we can complete it to a (complete) measure on all null measurable sets. -/
def completion {_ : measurable_space α} (μ : measure α) :
  @measure_theory.measure (null_measurable_space α μ) _ :=
{ to_outer_measure := μ.to_outer_measure,
  m_Union := λ s hs hd, measure_Union₀ hd hs,
  trimmed := begin
    refine le_antisymm (λ s, _) (outer_measure.le_trim _),
    rw outer_measure.trim_eq_infi, simp only [to_outer_measure_apply],
    refine (binfi_le_binfi _).trans_eq (measure_eq_infi _).symm,
    exact λ t ht, infi_le_infi2 (λ h, ⟨h.null_measurable_set, le_rfl⟩)
  end }

instance completion.is_complete {m : measurable_space α} (μ : measure α) :
  μ.completion.is_complete :=
⟨λ z hz, null_measurable_set.of_null hz⟩

@[simp] lemma coe_completion {_ : measurable_space α} (μ : measure α) :
  ⇑μ.completion = μ := rfl

lemma completion_apply {_ : measurable_space α} (μ : measure α) (s : set α) :
  μ.completion s = μ s := rfl

end measure

end is_complete

end measure_theory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Scott Morrison
-/
import category_theory.natural_isomorphism
import category_theory.eq_to_hom

/-!
# Categories of indexed families of objects.

We define the pointwise category structure on indexed families of objects in a category
(and also the dependent generalization).

-/

namespace category_theory

universes w₀ w₁ w₂ v₁ v₂ u₁ u₂

variables {I : Type w₀} (C : I → Type u₁) [Π i, category.{v₁} (C i)]

/--
`pi C` gives the cartesian product of an indexed family of categories.
-/
instance pi : category.{max w₀ v₁} (Π i, C i) :=
{ hom := λ X Y, Π i, X i ⟶ Y i,
  id := λ X i, 𝟙 (X i),
  comp := λ X Y Z f g i, f i ≫ g i }

/--
This provides some assistance to typeclass search in a common situation,
which otherwise fails. (Without this `category_theory.pi.has_limit_of_has_limit_comp_eval` fails.)
-/
abbreviation pi' {I : Type v₁} (C : I → Type u₁) [Π i, category.{v₁} (C i)] :
  category.{v₁} (Π i, C i) :=
category_theory.pi C

attribute [instance] pi'

namespace pi

@[simp] lemma id_apply (X : Π i, C i) (i) : (𝟙 X : Π i, X i ⟶ X i) i = 𝟙 (X i) := rfl
@[simp] lemma comp_apply {X Y Z : Π i, C i} (f : X ⟶ Y) (g : Y ⟶ Z) (i) :
  (f ≫ g : Π i, X i ⟶ Z i) i = f i ≫ g i := rfl

/--
The evaluation functor at `i : I`, sending an `I`-indexed family of objects to the object over `i`.
-/
@[simps]
def eval (i : I) : (Π i, C i) ⥤ C i :=
{ obj := λ f, f i,
  map := λ f g α, α i, }

section
variables {J : Type w₁}

/--
Pull back an `I`-indexed family of objects to an `J`-indexed family, along a function `J → I`.
-/
@[simps]
def comap (h : J → I) : (Π i, C i) ⥤ (Π j, C (h j)) :=
{ obj := λ f i, f (h i),
  map := λ f g α i, α (h i), }

variables (I)
/--
The natural isomorphism between
pulling back a grading along the identity function,
and the identity functor. -/
@[simps]
def comap_id : comap C (id : I → I) ≅ 𝟭 (Π i, C i) :=
{ hom := { app := λ X, 𝟙 X },
  inv := { app := λ X, 𝟙 X } }.

variables {I}
variables {K : Type w₂}

/--
The natural isomorphism comparing between
pulling back along two successive functions, and
pulling back along their composition
-/
@[simps]
def comap_comp (f : K → J) (g : J → I) : comap C g ⋙ comap (C ∘ g) f ≅ comap C (g ∘ f) :=
{ hom := { app := λ X b, 𝟙 (X (g (f b))) },
  inv := { app := λ X b, 𝟙 (X (g (f b))) } }

/-- The natural isomorphism between pulling back then evaluating, and just evaluating. -/
@[simps]
def comap_eval_iso_eval (h : J → I) (j : J) : comap C h ⋙ eval (C ∘ h) j ≅ eval C (h j) :=
nat_iso.of_components (λ f, iso.refl _) (by tidy)

end

section
variables {J : Type w₀} {D : J → Type u₁} [Π j, category.{v₁} (D j)]

instance sum_elim_category : Π (s : I ⊕ J), category.{v₁} (sum.elim C D s)
| (sum.inl i) := by { dsimp, apply_instance, }
| (sum.inr j) := by { dsimp, apply_instance, }

/--
The bifunctor combining an `I`-indexed family of objects with a `J`-indexed family of objects
to obtain an `I ⊕ J`-indexed family of objects.
-/
@[simps]
def sum : (Π i, C i) ⥤ (Π j, D j) ⥤ (Π s : I ⊕ J, sum.elim C D s) :=
{ obj := λ f,
  { obj := λ g s, sum.rec f g s,
    map := λ g g' α s, sum.rec (λ i, 𝟙 (f i)) α s },
  map := λ f f' α,
  { app := λ g s, sum.rec α (λ j, 𝟙 (g j)) s, }}

end

variables {C}

/-- An isomorphism between `I`-indexed objects gives an isomorphism between each
pair of corresponding components. -/
@[simps] def iso_app {X Y : Π i, C i} (f : X ≅ Y) (i : I) : X i ≅ Y i :=
⟨f.hom i, f.inv i, by { dsimp, rw [← comp_apply, iso.hom_inv_id, id_apply] },
  by { dsimp, rw [← comp_apply, iso.inv_hom_id, id_apply] }⟩

@[simp] lemma iso_app_refl (X : Π i, C i) (i : I) : iso_app (iso.refl X) i = iso.refl (X i) := rfl
@[simp] lemma iso_app_symm {X Y : Π i, C i} (f : X ≅ Y) (i : I) :
  iso_app f.symm i = (iso_app f i).symm := rfl
@[simp] lemma iso_app_trans {X Y Z : Π i, C i} (f : X ≅ Y) (g : Y ≅ Z) (i : I) :
  iso_app (f ≪≫ g) i = iso_app f i ≪≫ iso_app g i := rfl

end pi

namespace functor

variables {C}
variables {D : I → Type u₁} [∀ i, category.{v₁} (D i)]

/--
Assemble an `I`-indexed family of functors into a functor between the pi types.
-/
@[simps]
def pi (F : Π i, C i ⥤ D i) : (Π i, C i) ⥤ (Π i, D i) :=
{ obj := λ f i, (F i).obj (f i),
  map := λ f g α i, (F i).map (α i) }

-- One could add some natural isomorphisms showing
-- how `functor.pi` commutes with `pi.eval` and `pi.comap`.

end functor

namespace nat_trans

variables {C}
variables {D : I → Type u₁} [∀ i, category.{v₁} (D i)]
variables {F G : Π i, C i ⥤ D i}

/--
Assemble an `I`-indexed family of natural transformations into a single natural transformation.
-/
@[simps]
def pi (α : Π i, F i ⟶ G i) : functor.pi F ⟶ functor.pi G :=
{ app := λ f i, (α i).app (f i), }

end nat_trans

end category_theory


import data.real.basic

open nat

--BEGIN

example (a b : ℕ) : a * b = b * a :=
begin
 sorry,
end

example (a b t : ℕ) : (a + b) * t = a * t + b * t :=
begin
 sorry,
end

--END


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Scott Morrison

Case bashing:
* on `x ∈ A`, for `A : finset α` or `A : list α`, or
* on `x : A`, with `[fintype A]`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.tactic.norm_num
import Mathlib.PostPort

namespace Mathlib

namespace tactic

/-- Checks that the expression looks like `x ∈ A` for `A : finset α`, `multiset α` or `A : list α`,
    and returns the type α. -/
/--
`expr_list_to_list_expr` converts an `expr` of type `list α`
to a list of `expr`s each with type `α`.

TODO: this should be moved, and possibly duplicates an existing definition.
-/
/--
`fin_cases_at with_list e` performs case analysis on `e : α`, where `α` is a fintype.
The optional list of expressions `with_list` provides descriptions for the cases of `e`,
for example, to display nats as `n.succ` instead of `n+1`.
These should be defeq to and in the same order as the terms in the enumeration of `α`.
-/
namespace interactive

/--
`fin_cases h` performs case analysis on a hypothesis of the form
`h : A`, where `[fintype A]` is available, or
`h ∈ A`, where `A : finset X`, `A : multiset X` or `A : list X`.

`fin_cases *` performs case analysis on all suitable hypotheses.

As an example, in
```
example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *; simp,
  all_goals { assumption }
end
```
after `fin_cases p; simp`, there are three goals, `f 0`, `f 1`, and `f 2`.
-/
end interactive


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

/-!
# Order isomorhpisms and bounds.

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

variables {α β : Type*}
open set

namespace order_iso

variables [preorder α] [preorder β] (f : α ≃o β)

lemma lower_bounds_image {s : set α} : lower_bounds (f '' s) = f '' lower_bounds s :=
@upper_bounds_image αᵒᵈ βᵒᵈ _ _ f.dual _

@[simp] lemma is_lub_image {s : set α} {x : β} :
  is_lub (f '' s) x ↔ is_lub s (f.symm x) :=
⟨λ h, is_lub.of_image (λ _ _, f.le_iff_le) ((f.apply_symm_apply x).symm ▸ h),
  λ h, is_lub.of_image (λ _ _, f.symm.le_iff_le) $ (f.symm_image_image s).symm ▸ h⟩

lemma is_lub_image' {s : set α} {x : α} :
  is_lub (f '' s) (f x) ↔ is_lub s x :=
by rw [is_lub_image, f.symm_apply_apply]

@[simp] lemma is_glb_image {s : set α} {x : β} :
  is_glb (f '' s) x ↔ is_glb s (f.symm x) :=
f.dual.is_lub_image

lemma is_glb_image' {s : set α} {x : α} :
  is_glb (f '' s) (f x) ↔ is_glb s x :=
f.dual.is_lub_image'

@[simp] lemma is_lub_preimage {s : set β} {x : α} :
  is_lub (f ⁻¹' s) x ↔ is_lub s (f x) :=
by rw [← f.symm_symm, ← image_eq_preimage, is_lub_image]

lemma is_lub_preimage' {s : set β} {x : β} :
  is_lub (f ⁻¹' s) (f.symm x) ↔ is_lub s x :=
by rw [is_lub_preimage, f.apply_symm_apply]

@[simp] lemma is_glb_preimage {s : set β} {x : α} :
  is_glb (f ⁻¹' s) x ↔ is_glb s (f x) :=
f.dual.is_lub_preimage

lemma is_glb_preimage' {s : set β} {x : β} :
  is_glb (f ⁻¹' s) (f.symm x) ↔ is_glb s x :=
f.dual.is_lub_preimage'

end order_iso


/-
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

Some big operators for lists and finite sets.
-/
import data.list.basic data.list.perm data.finset
  algebra.group algebra.ordered_group algebra.group_power

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

theorem directed.finset_le {r : α → α → Prop} [is_trans α r]
  {ι} (hι : nonempty ι) {f : ι → α} (D : directed r f) (s : finset ι) :
  ∃ z, ∀ i ∈ s, r (f i) (f z) :=
show ∃ z, ∀ i ∈ s.1, r (f i) (f z), from
multiset.induction_on s.1 (by simp [exists_true_iff_nonempty, hι]) $
begin
  rintro i s ⟨j, H⟩,
  rcases D i j with ⟨k, h₁, h₂⟩, existsi k,
  simp, rintro a (rfl | h),
  exacts [h₁, trans (H _ h) h₂]
end

namespace finset
variables {s s₁ s₂ : finset α} {a : α} {f g : α → β}

/-- `prod s f` is the product of `f x` as `x` ranges over the elements of the finite set `s`. -/
@[to_additive finset.sum]
protected def prod [comm_monoid β] (s : finset α) (f : α → β) : β := (s.1.map f).prod
attribute [to_additive finset.sum.equations._eqn_1] finset.prod.equations._eqn_1

@[to_additive finset.sum_eq_fold]
theorem prod_eq_fold [comm_monoid β] (s : finset α) (f : α → β) : s.prod f = s.fold (*) 1 f := rfl

section comm_monoid
variables [comm_monoid β]

@[simp, to_additive finset.sum_empty]
lemma prod_empty {α : Type u} {f : α → β} : (∅:finset α).prod f = 1 := rfl

@[simp, to_additive finset.sum_insert]
lemma prod_insert [decidable_eq α] : a ∉ s → (insert a s).prod f = f a * s.prod f := fold_insert

@[simp, to_additive finset.sum_singleton]
lemma prod_singleton : (singleton a).prod f = f a :=
eq.trans fold_singleton (by simp)

@[simp] lemma prod_const_one : s.prod (λx, (1 : β)) = 1 :=
by simp [finset.prod]
@[simp] lemma sum_const_zero {β} {s : finset α} [add_comm_monoid β] : s.sum (λx, (0 : β)) = 0 :=
@prod_const_one _ (multiplicative β) _ _
attribute [to_additive finset.sum_const_zero] prod_const_one

@[simp, to_additive finset.sum_image]
lemma prod_image [decidable_eq α] [decidable_eq γ] {s : finset γ} {g : γ → α} :
  (∀x∈s, ∀y∈s, g x = g y → x = y) → (s.image g).prod f = s.prod (λx, f (g x)) :=
fold_image

@[congr, to_additive finset.sum_congr]
lemma prod_congr (h : s₁ = s₂) : (∀x∈s₂, f x = g x) → s₁.prod f = s₂.prod g :=
by rw [h]; exact fold_congr
attribute [congr] finset.sum_congr

@[to_additive finset.sum_union_inter]
lemma prod_union_inter [decidable_eq α] : (s₁ ∪ s₂).prod f * (s₁ ∩ s₂).prod f = s₁.prod f * s₂.prod f :=
fold_union_inter

@[to_additive finset.sum_union]
lemma prod_union [decidable_eq α] (h : s₁ ∩ s₂ = ∅) : (s₁ ∪ s₂).prod f = s₁.prod f * s₂.prod f :=
by rw [←prod_union_inter, h]; simp

@[to_additive finset.sum_sdiff]
lemma prod_sdiff [decidable_eq α] (h : s₁ ⊆ s₂) : (s₂ \ s₁).prod f * s₁.prod f = s₂.prod f :=
by rw [←prod_union (sdiff_inter_self _ _), sdiff_union_of_subset h]

@[to_additive finset.sum_bind]
lemma prod_bind [decidable_eq α] {s : finset γ} {t : γ → finset α} :
  (∀x∈s, ∀y∈s, x ≠ y → t x ∩ t y = ∅) → (s.bind t).prod f = s.prod (λx, (t x).prod f) :=
by haveI := classical.dec_eq γ; exact
finset.induction_on s (by simp)
  (assume x s hxs ih hd,
  have hd' : ∀x∈s, ∀y∈s, x ≠ y → t x ∩ t y = ∅,
    from assume _ hx _ hy, hd _ (mem_insert_of_mem hx) _ (mem_insert_of_mem hy),
  have t x ∩ finset.bind s t = ∅,
    from ext.2 $ assume a,
      by simp [mem_bind];
      from assume h₁ y hys hy₂,
      have ha : a ∈ t x ∩ t y, by simp [*],
      have t x ∩ t y = ∅,
        from hd _ (mem_insert_self _ _) _ (mem_insert_of_mem hys) $ assume h, hxs $ h.symm ▸ hys,
      by rwa [this] at ha,
  by simp [hxs, prod_union this, ih hd'] {contextual := tt})

@[to_additive finset.sum_product]
lemma prod_product {s : finset γ} {t : finset α} {f : γ×α → β} :
  (s.product t).prod f = s.prod (λx, t.prod $ λy, f (x, y)) :=
begin
  haveI := classical.dec_eq α, haveI := classical.dec_eq γ,
  rw [product_eq_bind, prod_bind (λ x hx y hy h, ext.2 _)], {simp [prod_image]},
  simp [mem_image], intros, intro, refine h _, cc
end

@[to_additive finset.sum_sigma]
lemma prod_sigma {σ : α → Type*}
  {s : finset α} {t : Πa, finset (σ a)} {f : sigma σ → β} :
  (s.sigma t).prod f = s.prod (λa, (t a).prod $ λs, f ⟨a, s⟩) :=
by haveI := classical.dec_eq α; haveI := (λ a, classical.dec_eq (σ a)); exact
have ∀a₁ a₂:α, ∀s₁ : finset (σ a₁), ∀s₂ : finset (σ a₂), a₁ ≠ a₂ →
    s₁.image (sigma.mk a₁) ∩ s₂.image (sigma.mk a₂) = ∅,
  from assume b₁ b₂ s₁ s₂ h, ext.2 $ assume ⟨b₃, c₃⟩,
    by simp [mem_image, sigma.mk.inj_iff, heq_iff_eq] {contextual := tt}; cc,
calc (s.sigma t).prod f =
       (s.bind (λa, (t a).image (λs, sigma.mk a s))).prod f : by rw sigma_eq_bind
  ... = s.prod (λa, ((t a).image (λs, sigma.mk a s)).prod f) :
    prod_bind $ assume a₁ ha a₂ ha₂ h, this a₁ a₂ (t a₁) (t a₂) h
  ... = (s.prod $ λa, (t a).prod $ λs, f ⟨a, s⟩) :
    by simp [prod_image, sigma.mk.inj_iff, heq_iff_eq]

@[to_additive finset.sum_add_distrib]
lemma prod_mul_distrib : s.prod (λx, f x * g x) = s.prod f * s.prod g :=
eq.trans (by simp; refl) fold_op_distrib

@[to_additive finset.sum_comm]
lemma prod_comm [decidable_eq γ] {s : finset γ} {t : finset α} {f : γ → α → β} :
  s.prod (λx, t.prod $ f x) = t.prod (λy, s.prod $ λx, f x y) :=
finset.induction_on s (by simp) (by simp [prod_mul_distrib] {contextual := tt})

@[to_additive finset.sum_hom]
lemma prod_hom [comm_monoid γ] (g : β → γ)
  (h₁ : g 1 = 1) (h₂ : ∀x y, g (x * y) = g x * g y) : s.prod (λx, g (f x)) = g (s.prod f) :=
eq.trans (by rw [h₁]; refl) (fold_hom h₂)

lemma sum_nat_cast [add_comm_monoid β] [has_one β] (s : finset α) (f : α → ℕ) :
  ↑(s.sum f) = s.sum (λa, f a : α → β) :=
(sum_hom _ nat.cast_zero nat.cast_add).symm

@[to_additive finset.sum_subset]
lemma prod_subset (h : s₁ ⊆ s₂) (hf : ∀x∈s₂, x ∉ s₁ → f x = 1) : s₁.prod f = s₂.prod f :=
by haveI := classical.dec_eq α; exact
have (s₂ \ s₁).prod f = (s₂ \ s₁).prod (λx, 1),
  from prod_congr rfl begin simp [hf] {contextual := tt} end,
by rw [←prod_sdiff h]; simp [this]

@[to_additive finset.sum_eq_single]
lemma prod_eq_single {s : finset α} {f : α → β} (a : α)
  (h₀ : ∀b∈s, b ≠ a → f b = 1) (h₁ : a ∉ s → f a = 1) : s.prod f = f a :=
by haveI := classical.dec_eq α;
from classical.by_cases
  (assume : a ∈ s,
    calc s.prod f = ({a} : finset α).prod f :
      begin
        refine (prod_subset _ _).symm,
        { simp [finset.subset_iff, this] },
        { simpa using h₀ }
      end
      ... = f a : by simp)
  (assume : a ∉ s,
    have ∀b, b ∈ s → f b = 1,
      from assume b hb, h₀ b hb $ assume eq, this $ eq ▸ hb,
    calc s.prod f = (∅ : finset α).prod f : (prod_subset (empty_subset s) $ by simpa).symm
      ... = f a : (h₁ ‹a ∉ s›).symm)

@[to_additive finset.sum_attach]
lemma prod_attach {f : α → β} : s.attach.prod (λx, f x.val) = s.prod f :=
by haveI := classical.dec_eq α; exact
calc s.attach.prod (λx, f x.val) = ((s.attach).image subtype.val).prod f :
    by rw [prod_image]; exact assume x _ y _, subtype.eq
  ... = _ : by rw [attach_image_val]

@[to_additive finset.sum_bij]
lemma prod_bij {s : finset α} {t : finset γ} {f : α → β} {g : γ → β}
  (i : Πa∈s, γ) (hi : ∀a ha, i a ha ∈ t) (h : ∀a ha, f a = g (i a ha))
  (i_inj : ∀a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂) (i_surj : ∀b∈t, ∃a ha, b = i a ha) :
  s.prod f = t.prod g :=
by haveI := classical.prop_decidable; exact
calc s.prod f = s.attach.prod (λx, f x.val) : prod_attach.symm
  ... = s.attach.prod (λx, g (i x.1 x.2)) : prod_congr rfl $ assume x hx, h _ _
  ... = (s.attach.image $ λx:{x // x ∈ s}, i x.1 x.2).prod g :
    (prod_image $ assume (a₁:{x // x ∈ s}) _ a₂ _ eq, subtype.eq $ i_inj a₁.1 a₂.1 a₁.2 a₂.2 eq).symm
  ... = _ :
      prod_subset
        (by simp [subset_iff]; intros b a h eq; subst eq; exact hi _ _)
        (assume b hb, not_imp_comm.mp $ assume hb₂,
          let ⟨a, ha, eq⟩ := i_surj b hb in by simp [eq]; exact ⟨_, _, rfl⟩)

@[to_additive finset.sum_bij_ne_zero]
lemma prod_bij_ne_one {s : finset α} {t : finset γ} {f : α → β} {g : γ → β}
  (i : Πa∈s, f a ≠ 1 → γ) (hi₁ : ∀a h₁ h₂, i a h₁ h₂ ∈ t)
  (hi₂ : ∀a₁ a₂ h₁₁ h₁₂ h₂₁ h₂₂, i a₁ h₁₁ h₁₂ = i a₂ h₂₁ h₂₂ → a₁ = a₂)
  (hi₃ : ∀b∈t, g b ≠ 1 → ∃a h₁ h₂, b = i a h₁ h₂)
  (h : ∀a h₁ h₂, f a = g (i a h₁ h₂)) :
  s.prod f = t.prod g :=
by haveI := classical.prop_decidable; exact
calc s.prod f = (s.filter $ λx, f x ≠ 1).prod f :
    (prod_subset (filter_subset _) $ by simp {contextual:=tt}).symm
  ... = (t.filter $ λx, g x ≠ 1).prod g :
    prod_bij (assume a ha, i a (mem_filter.mp ha).1 (mem_filter.mp ha).2)
      (assume a ha, (mem_filter.mp ha).elim $ λh₁ h₂, mem_filter.mpr
        ⟨hi₁ a h₁ h₂, λ hg, h₂ (hg ▸ h a h₁ h₂)⟩)
      (assume a ha, (mem_filter.mp ha).elim $ h a)
      (assume a₁ a₂ ha₁ ha₂,
        (mem_filter.mp ha₁).elim $ λha₁₁ ha₁₂, (mem_filter.mp ha₂).elim $ λha₂₁ ha₂₂, hi₂ a₁ a₂ _ _ _ _)
      (assume b hb, (mem_filter.mp hb).elim $ λh₁ h₂,
        let ⟨a, ha₁, ha₂, eq⟩ := hi₃ b h₁ h₂ in ⟨a, mem_filter.mpr ⟨ha₁, ha₂⟩, eq⟩)
  ... = t.prod g :
    (prod_subset (filter_subset _) $ by simp {contextual:=tt})

@[to_additive finset.exists_ne_zero_of_sum_ne_zero]
lemma exists_ne_one_of_prod_ne_one : s.prod f ≠ 1 → ∃a∈s, f a ≠ 1 :=
by haveI := classical.dec_eq α; exact
finset.induction_on s (by simp) (assume a s has ih h,
  classical.by_cases
    (assume ha : f a = 1,
      have s.prod f ≠ 1, by simpa [ha, has] using h,
      let ⟨a, ha, hfa⟩ := ih this in
      ⟨a, mem_insert_of_mem ha, hfa⟩)
    (assume hna : f a ≠ 1,
      ⟨a, mem_insert_self _ _, hna⟩))

@[to_additive finset.sum_range_succ]
lemma prod_range_succ (f : ℕ → β) (n : ℕ) :
  (range (nat.succ n)).prod f = f n * (range n).prod f := by simp

lemma prod_range_succ' (f : ℕ → β) :
  ∀ n : ℕ, (range (nat.succ n)).prod f = (range n).prod (f ∘ nat.succ) * f 0
| 0       := by simp
| (n + 1) := by rw [prod_range_succ (λ m, f (nat.succ m)), mul_assoc, ← prod_range_succ'];
                 exact prod_range_succ _ _

@[simp] lemma prod_const [decidable_eq α] (b : β) : s.prod (λ a, b) = b ^ s.card :=
finset.induction_on s rfl (by simp [pow_add, mul_comm] {contextual := tt})

end comm_monoid

@[simp] lemma sum_const [add_comm_monoid β] [decidable_eq α] (b : β) :
  s.sum (λ a, b) = add_monoid.smul s.card b :=
@prod_const _ (multiplicative β) _ _ _ _
attribute [to_additive finset.sum_const] prod_const

lemma sum_range_succ' [add_comm_monoid β] (f : ℕ → β) :
  ∀ n : ℕ, (range (nat.succ n)).sum f = (range n).sum (f ∘ nat.succ) + f 0 :=
@prod_range_succ' (multiplicative β) _ _
attribute [to_additive finset.sum_range_succ'] prod_range_succ'

section comm_group
variables [comm_group β]

@[simp, to_additive finset.sum_neg_distrib]
lemma prod_inv_distrib : s.prod (λx, (f x)⁻¹) = (s.prod f)⁻¹ :=
prod_hom has_inv.inv one_inv mul_inv

end comm_group

@[simp] theorem card_sigma {σ : α → Type*} (s : finset α) (t : Π a, finset (σ a)) :
  card (s.sigma t) = s.sum (λ a, card (t a)) :=
multiset.card_sigma _ _

end finset

namespace finset
variables {s s₁ s₂ : finset α} {f g : α → β} {b : β} {a : α}

@[simp] lemma sum_sub_distrib [add_comm_group β] : s.sum (λx, f x - g x) = s.sum f - s.sum g :=
by simp [sum_add_distrib]

section ordered_cancel_comm_monoid
variables [decidable_eq α] [ordered_cancel_comm_monoid β]

lemma sum_le_sum : (∀x∈s, f x ≤ g x) → s.sum f ≤ s.sum g :=
finset.induction_on s (by simp) $ assume a s ha ih h,
  have f a + s.sum f ≤ g a + s.sum g,
    from add_le_add (h _ (mem_insert_self _ _)) (ih $ assume x hx, h _ $ mem_insert_of_mem hx),
  by simp [*]

lemma zero_le_sum (h : ∀x∈s, 0 ≤ f x) : 0 ≤ s.sum f := le_trans (by simp) (sum_le_sum h)
lemma sum_le_zero (h : ∀x∈s, f x ≤ 0) : s.sum f ≤ 0 := le_trans (sum_le_sum h) (by simp)

end ordered_cancel_comm_monoid

section semiring
variables [semiring β]

lemma sum_mul : s.sum f * b = s.sum (λx, f x * b) :=
(sum_hom (λx, x * b) (zero_mul b) (assume a c, add_mul a c b)).symm

lemma mul_sum : b * s.sum f = s.sum (λx, b * f x) :=
(sum_hom (λx, b * x) (mul_zero b) (assume a c, mul_add b a c)).symm

end semiring

section comm_semiring
variables [decidable_eq α] [comm_semiring β]

lemma prod_eq_zero (ha : a ∈ s) (h : f a = 0) : s.prod f = 0 :=
calc s.prod f = (insert a (erase s a)).prod f : by simp [ha, insert_erase]
  ... = 0 : by simp [h]

lemma prod_sum {δ : α → Type*} [∀a, decidable_eq (δ a)]
  {s : finset α} {t : Πa, finset (δ a)} {f : Πa, δ a → β} :
  s.prod (λa, (t a).sum (λb, f a b)) =
    (s.pi t).sum (λp, s.attach.prod (λx, f x.1 (p x.1 x.2))) :=
begin
  induction s using finset.induction with a s ha ih,
  { simp },
  { have h₁ : ∀x ∈ t a, ∀y∈t a, ∀h : x ≠ y,
        image (pi.cons s a x) (pi s t) ∩ image (pi.cons s a y) (pi s t) = ∅,
    { assume x hx y hy h,
      apply eq_empty_of_forall_not_mem,
      simp,
      assume p₁ p₂ hp eq p₃ hp₃ eq', subst eq',
      have : pi.cons s a x p₂ a (mem_insert_self _ _) = pi.cons s a y p₃ a (mem_insert_self _ _),
      { rw [eq] },
      rw [pi.cons_same, pi.cons_same] at this,
      exact h this },
    have h₂ : ∀b:δ a, ∀p₁∈pi s t, ∀p₂∈pi s t, pi.cons s a b p₁ = pi.cons s a b p₂ → p₁ = p₂, from
      assume b p₁ h₁ p₂ h₂ eq, injective_pi_cons ha eq,
    have h₃ : ∀(v:{x // x ∈ s}) (b:δ a) (h : v.1 ∈ insert a s) (p : Πa, a ∈ s → δ a),
        pi.cons s a b p v.1 h = p v.1 v.2, from
      assume v b h p, pi.cons_ne $ assume eq, ha $ eq.symm ▸ v.2,
    simp [ha, ih, sum_bind h₁, sum_image (h₂ _), sum_mul, h₃],
    simp [mul_sum] }
end

end comm_semiring

section integral_domain /- add integral_semi_domain to support nat and ennreal -/
variables [decidable_eq α] [integral_domain β]

lemma prod_eq_zero_iff : s.prod f = 0 ↔ (∃a∈s, f a = 0) :=
finset.induction_on s (by simp)
begin
  intros a s,
  rw [bex_def, bex_def, exists_mem_insert],
  simp [mul_eq_zero_iff_eq_zero_or_eq_zero] {contextual := tt}
end

end integral_domain

section ordered_comm_monoid
variables [decidable_eq α] [ordered_comm_monoid β]

lemma sum_le_sum' : (∀x∈s, f x ≤ g x) → s.sum f ≤ s.sum g :=
finset.induction_on s (by simp; refl) $ assume a s ha ih h,
  have f a + s.sum f ≤ g a + s.sum g,
    from add_le_add' (h _ (mem_insert_self _ _)) (ih $ assume x hx, h _ $ mem_insert_of_mem hx),
  by simp [*]

lemma zero_le_sum' (h : ∀x∈s, 0 ≤ f x) : 0 ≤ s.sum f := le_trans (by simp) (sum_le_sum' h)
lemma sum_le_zero' (h : ∀x∈s, f x ≤ 0) : s.sum f ≤ 0 := le_trans (sum_le_sum' h) (by simp)

lemma sum_le_sum_of_subset_of_nonneg
  (h : s₁ ⊆ s₂) (hf : ∀x∈s₂, x ∉ s₁ → 0 ≤ f x) : s₁.sum f ≤ s₂.sum f :=
calc s₁.sum f ≤ (s₂ \ s₁).sum f + s₁.sum f :
    le_add_of_nonneg_left' $ zero_le_sum' $ by simp [hf] {contextual := tt}
  ... = (s₂ \ s₁ ∪ s₁).sum f : (sum_union (sdiff_inter_self _ _)).symm
  ... = s₂.sum f : by rw [sdiff_union_of_subset h]

lemma sum_eq_zero_iff_of_nonneg : (∀x∈s, 0 ≤ f x) → (s.sum f = 0 ↔ ∀x∈s, f x = 0) :=
finset.induction_on s (by simp) $
  by simp [or_imp_distrib, forall_and_distrib, zero_le_sum' ,
           add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg'] {contextual := tt}

lemma single_le_sum (hf : ∀x∈s, 0 ≤ f x) {a} (h : a ∈ s) : f a ≤ s.sum f :=
by simpa using show (singleton a).sum f ≤ s.sum f,
from sum_le_sum_of_subset_of_nonneg
 (λ x e, (mem_singleton.1 e).symm ▸ h) (λ x h _, hf x h)

end ordered_comm_monoid

section canonically_ordered_monoid
variables [decidable_eq α] [canonically_ordered_monoid β] [@decidable_rel β (≤)]

lemma sum_le_sum_of_subset (h : s₁ ⊆ s₂) : s₁.sum f ≤ s₂.sum f :=
sum_le_sum_of_subset_of_nonneg h $ assume x h₁ h₂, zero_le _

lemma sum_le_sum_of_ne_zero (h : ∀x∈s₁, f x ≠ 0 → x ∈ s₂) : s₁.sum f ≤ s₂.sum f :=
calc s₁.sum f = (s₁.filter (λx, f x = 0)).sum f + (s₁.filter (λx, f x ≠ 0)).sum f :
    by rw [←sum_union, filter_union_filter_neg_eq]; apply filter_inter_filter_neg_eq
  ... ≤ s₂.sum f : add_le_of_nonpos_of_le'
      (sum_le_zero' $ by simp {contextual:=tt})
      (sum_le_sum_of_subset $ by simp [subset_iff, *] {contextual:=tt})

end canonically_ordered_monoid

section discrete_linear_ordered_field
variables [discrete_linear_ordered_field α] [decidable_eq β]

lemma abs_sum_le_sum_abs {f : β → α} {s : finset β} : abs (s.sum f) ≤ s.sum (λa, abs (f a)) :=
finset.induction_on s (by simp [abs_zero]) $
  assume a s has ih,
  calc abs (sum (insert a s) f) ≤ abs (f a) + abs (sum s f) :
      by simp [has]; exact abs_add_le_abs_add_abs _ _
    ... ≤ abs (f a) + s.sum (λa, abs (f a)) : add_le_add (le_refl _) ih
    ... ≤ sum (insert a s) (λ (a : β), abs (f a)) : by simp [has]

end discrete_linear_ordered_field

@[simp] lemma card_pi [decidable_eq α] {δ : α → Type*}
  (s : finset α) (t : Π a, finset (δ a)) :
  (s.pi t).card = s.prod (λ a, card (t a)) :=
multiset.card_pi _ _

end finset

section group

open list
variables [group α] [group β]

theorem is_group_hom.prod (f : α → β) [is_group_hom f] (l : list α) :
  f (prod l) = prod (map f l) :=
by induction l; simp [*, is_group_hom.mul f, is_group_hom.one f]

theorem is_group_anti_hom.prod (f : α → β) [is_group_anti_hom f] (l : list α) :
  f (prod l) = prod (map f (reverse l)) :=
by induction l; simp [*, is_group_anti_hom.mul f, is_group_anti_hom.one f]

theorem inv_prod : ∀ l : list α, (prod l)⁻¹ = prod (map (λ x, x⁻¹) (reverse l)) :=
λ l, @is_group_anti_hom.prod _ _ _ _ _ inv_is_group_anti_hom l -- TODO there is probably a cleaner proof of this

end group

namespace multiset
variables [decidable_eq α]

@[simp] lemma to_finset_sum_count_eq (s : multiset α) :
  s.to_finset.sum (λa, s.count a) = s.card :=
multiset.induction_on s (by simp)
  (assume a s ih,
    calc (to_finset (a :: s)).sum (λx, count x (a :: s)) =
      (to_finset (a :: s)).sum (λx, (if x = a then 1 else 0) + count x s) :
        by congr; funext x; split_ifs; simp [h, nat.one_add]
      ... = card (a :: s) :
      begin
        by_cases a ∈ s.to_finset,
        { have : (to_finset s).sum (λx, ite (x = a) 1 0) = ({a}:finset α).sum (λx, ite (x = a) 1 0),
          { apply (finset.sum_subset _ _).symm,
            { simp [finset.subset_iff, *] at * },
            { simp [if_neg] {contextual := tt} } },
          simp [h, ih, this, finset.sum_add_distrib] },
        { have : a ∉ s, by simp * at *,
          have : (to_finset s).sum (λx, ite (x = a) 1 0) = (to_finset s).sum (λx, 0), from
            finset.sum_congr rfl begin assume a ha, split_ifs; simp [*] at * end,
          simp [*, finset.sum_add_distrib], }
      end)

end multiset


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.inner_product_space.calculus
import analysis.inner_product_space.pi_L2

/-!
# Euclidean distance on a finite dimensional space

When we define a smooth bump function on a normed space, it is useful to have a smooth distance on
the space. Since the default distance is not guaranteed to be smooth, we define `to_euclidean` to be
an equivalence between a finite dimensional normed space and the standard Euclidean space of the
same dimension. Then we define `euclidean.dist x y = dist (to_euclidean x) (to_euclidean y)` and
provide some definitions (`euclidean.ball`, `euclidean.closed_ball`) and simple lemmas about this
distance. This way we hide the usage of `to_euclidean` behind an API.
-/

open_locale topological_space
open set

variables {E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]

noncomputable theory

/-- If `E` is a finite dimensional space over `ℝ`, then `to_euclidean` is a continuous `ℝ`-linear
equivalence between `E` and the Euclidean space of the same dimension. -/
def to_euclidean : E ≃L[ℝ] euclidean_space ℝ (fin $ finite_dimensional.finrank ℝ E) :=
continuous_linear_equiv.of_finrank_eq finrank_euclidean_space_fin.symm

namespace euclidean

/-- If `x` and `y` are two points in a finite dimensional space over `ℝ`, then `euclidean.dist x y`
is the distance between these points in the metric defined by some inner product space structure on
`E`. -/
def dist (x y : E) : ℝ := dist (to_euclidean x) (to_euclidean y)

/-- Closed ball w.r.t. the euclidean distance. -/
def closed_ball (x : E) (r : ℝ) : set E := {y | dist y x ≤ r}

/-- Open ball w.r.t. the euclidean distance. -/
def ball (x : E) (r : ℝ) : set E := {y | dist y x < r}

lemma ball_eq_preimage (x : E) (r : ℝ) :
  ball x r = to_euclidean ⁻¹' (metric.ball (to_euclidean x) r) :=
rfl

lemma closed_ball_eq_preimage (x : E) (r : ℝ) :
  closed_ball x r = to_euclidean ⁻¹' (metric.closed_ball (to_euclidean x) r) :=
rfl

lemma ball_subset_closed_ball {x : E} {r : ℝ} : ball x r ⊆ closed_ball x r :=
λ y (hy : _ < _), le_of_lt hy

lemma is_open_ball {x : E} {r : ℝ} : is_open (ball x r) :=
metric.is_open_ball.preimage to_euclidean.continuous

lemma mem_ball_self {x : E} {r : ℝ} (hr : 0 < r) : x ∈ ball x r := metric.mem_ball_self hr

lemma closed_ball_eq_image (x : E) (r : ℝ) :
  closed_ball x r = to_euclidean.symm '' metric.closed_ball (to_euclidean x) r :=
by rw [to_euclidean.image_symm_eq_preimage, closed_ball_eq_preimage]

lemma is_compact_closed_ball {x : E} {r : ℝ} : is_compact (closed_ball x r) :=
begin
  rw closed_ball_eq_image,
  exact (proper_space.is_compact_closed_ball _ _).image to_euclidean.symm.continuous
end

lemma is_closed_closed_ball {x : E} {r : ℝ} : is_closed (closed_ball x r) :=
is_compact_closed_ball.is_closed

lemma closure_ball (x : E) {r : ℝ} (h : 0 < r) : closure (ball x r) = closed_ball x r :=
by rw [ball_eq_preimage, ← to_euclidean.preimage_closure, closure_ball (to_euclidean x) h,
  closed_ball_eq_preimage]

lemma exists_pos_lt_subset_ball {R : ℝ} {s : set E} {x : E}
  (hR : 0 < R) (hs : is_closed s) (h : s ⊆ ball x R) :
  ∃ r ∈ Ioo 0 R, s ⊆ ball x r :=
begin
  rw [ball_eq_preimage, ← image_subset_iff] at h,
  rcases exists_pos_lt_subset_ball hR (to_euclidean.is_closed_image.2 hs) h with ⟨r, hr, hsr⟩,
  exact ⟨r, hr, image_subset_iff.1 hsr⟩
end

lemma nhds_basis_closed_ball {x : E} :
  (𝓝 x).has_basis (λ r : ℝ, 0 < r) (closed_ball x) :=
begin
  rw [to_euclidean.to_homeomorph.nhds_eq_comap],
  exact metric.nhds_basis_closed_ball.comap _
end

lemma closed_ball_mem_nhds {x : E} {r : ℝ} (hr : 0 < r) : closed_ball x r ∈ 𝓝 x :=
nhds_basis_closed_ball.mem_of_mem hr

lemma nhds_basis_ball {x : E} :
  (𝓝 x).has_basis (λ r : ℝ, 0 < r) (ball x) :=
begin
  rw [to_euclidean.to_homeomorph.nhds_eq_comap],
  exact metric.nhds_basis_ball.comap _
end

lemma ball_mem_nhds {x : E} {r : ℝ} (hr : 0 < r) : ball x r ∈ 𝓝 x :=
nhds_basis_ball.mem_of_mem hr

end euclidean

variables {F : Type*} [normed_group F] [normed_space ℝ F] {f g : F → E} {n : with_top ℕ}

lemma times_cont_diff.euclidean_dist (hf : times_cont_diff ℝ n f) (hg : times_cont_diff ℝ n g)
  (h : ∀ x, f x ≠ g x) :
  times_cont_diff ℝ n (λ x, euclidean.dist (f x) (g x)) :=
begin
  simp only [euclidean.dist],
  apply @times_cont_diff.dist ℝ,
  exacts [(@to_euclidean E _ _ _).times_cont_diff.comp hf,
    (@to_euclidean E _ _ _).times_cont_diff.comp hg, λ x, to_euclidean.injective.ne (h x)]
end


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

! This file was ported from Lean 3 source module data.finite.set
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Card

/-!
# Lemmas about `Finite` and `Set`s

In this file we prove two lemmas about `Finite` and `Set`s.

## Tags

finiteness, finite sets
-/

open Set

universe u v w

variable {α : Type u} {β : Type v} {ι : Sort w}

theorem Finite.Set.finite_of_finite_image (s : Set α) {f : α → β} (h : s.InjOn f)
    [Finite (f '' s)] : Finite s :=
  Finite.of_equiv _ (Equiv.ofBijective _ h.bijOn_image.bijective).symm
#align finite.set.finite_of_finite_image Finite.Set.finite_of_finite_image

theorem Finite.of_injective_finite_range {f : ι → α} (hf : Function.Injective f)
    [Finite (range f)] : Finite ι :=
  Finite.of_injective (Set.rangeFactorization f) (hf.codRestrict _)
#align finite.of_injective_finite_range Finite.of_injective_finite_range


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import data.complex.is_R_or_C
import analysis.normed_space.operator_norm
import analysis.normed_space.pointwise

/-!
# Normed spaces over R or C

This file is about results on normed spaces over the fields `ℝ` and `ℂ`.

## Main definitions

None.

## Main theorems

* `continuous_linear_map.op_norm_bound_of_ball_bound`: A bound on the norms of values of a linear
  map in a ball yields a bound on the operator norm.

## Notes

This file exists mainly to avoid importing `is_R_or_C` in the main normed space theory files.
-/

open metric

@[simp, is_R_or_C_simps] lemma is_R_or_C.norm_coe_norm {𝕜 : Type*} [is_R_or_C 𝕜]
  {E : Type*} [normed_group E] {z : E} : ∥(∥z∥ : 𝕜)∥ = ∥z∥ :=
by { unfold_coes, simp only [norm_algebra_map', ring_hom.to_fun_eq_coe, norm_norm], }

variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/
@[simp] lemma norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ∥(∥x∥⁻¹ : 𝕜) • x∥ = 1 :=
begin
  have : ∥x∥ ≠ 0 := by simp [hx],
  field_simp [norm_smul]
end

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to length `r`. -/
lemma norm_smul_inv_norm' {r : ℝ} (r_nonneg : 0 ≤ r) {x : E} (hx : x ≠ 0) :
  ∥(r * ∥x∥⁻¹ : 𝕜) • x∥ = r :=
begin
  have : ∥x∥ ≠ 0 := by simp [hx],
  field_simp [norm_smul, is_R_or_C.norm_eq_abs, r_nonneg] with is_R_or_C_simps
end

lemma linear_map.bound_of_sphere_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) (h : ∀ z ∈ sphere (0 : E) r, ∥f z∥ ≤ c) (z : E) :
  ∥f z∥ ≤ c / r * ∥z∥ :=
begin
  by_cases z_zero : z = 0,
  { rw z_zero, simp only [linear_map.map_zero, norm_zero, mul_zero], },
  set z₁ := (r * ∥z∥⁻¹ : 𝕜) • z with hz₁,
  have norm_f_z₁ : ∥f z₁∥ ≤ c,
  { apply h,
    rw mem_sphere_zero_iff_norm,
    exact norm_smul_inv_norm' r_pos.le z_zero },
  have r_ne_zero : (r : 𝕜) ≠ 0 := (algebra_map ℝ 𝕜).map_ne_zero.mpr r_pos.ne.symm,
  have eq : f z = ∥z∥ / r * (f z₁),
  { rw [hz₁, linear_map.map_smul, smul_eq_mul],
    rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul],
    simp only [z_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero, ne.def, not_false_iff], },
  rw [eq, norm_mul, norm_div, is_R_or_C.norm_coe_norm,
      is_R_or_C.norm_of_nonneg r_pos.le, div_mul_eq_mul_div, div_mul_eq_mul_div, mul_comm],
  apply div_le_div _ _ r_pos rfl.ge,
  { exact mul_nonneg ((norm_nonneg _).trans norm_f_z₁) (norm_nonneg z), },
  apply mul_le_mul norm_f_z₁ rfl.le (norm_nonneg z) ((norm_nonneg _).trans norm_f_z₁),
end

/--
`linear_map.bound_of_ball_bound` is a version of this over arbitrary nondiscrete normed fields.
It produces a less precise bound so we keep both versions. -/
lemma linear_map.bound_of_ball_bound' {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
  (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) (z : E) :
  ∥f z∥ ≤ c / r * ∥z∥ :=
f.bound_of_sphere_bound r_pos c (λ z hz, h z hz.le) z

lemma continuous_linear_map.op_norm_bound_of_ball_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) :
  ∥f∥ ≤ c / r :=
begin
  apply continuous_linear_map.op_norm_le_bound,
  { apply div_nonneg _ r_pos.le,
    exact (norm_nonneg _).trans
          (h 0 (by simp only [norm_zero, mem_closed_ball, dist_zero_left, r_pos.le])), },
  apply linear_map.bound_of_ball_bound' r_pos,
  exact λ z hz, h z hz,
end

variables (𝕜)
include 𝕜
lemma normed_space.sphere_nonempty_is_R_or_C [nontrivial E] {r : ℝ} (hr : 0 ≤ r) :
  nonempty (sphere (0:E) r) :=
begin
  letI : normed_space ℝ E := normed_space.restrict_scalars ℝ 𝕜 E,
  exact (sphere (0:E) r).nonempty_coe_sort.mpr (normed_space.sphere_nonempty.mpr hr),
end


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

/-!
# Equivalences involving `list`-like types

This file defines some additional constructive equivalences using `encodable` and the pairing
function on `ℕ`.
-/

open nat list

namespace encodable
variables {α : Type*}

section list
variable [encodable α]

/-- Explicit encoding function for `list α` -/
def encode_list : list α → ℕ
| []     := 0
| (a::l) := succ (mkpair (encode a) (encode_list l))

/-- Explicit decoding function for `list α` -/
def decode_list : ℕ → option (list α)
| 0        := some []
| (succ v) := match unpair v, unpair_right_le v with
  | (v₁, v₂), h :=
    have v₂ < succ v, from lt_succ_of_le h,
    (::) <$> decode α v₁ <*> decode_list v₂
  end

/-- If `α` is encodable, then so is `list α`. This uses the `mkpair` and `unpair` functions from
`data.nat.pairing`. -/
instance _root_.list.encodable : encodable (list α) :=
⟨encode_list, decode_list, λ l,
  by induction l with a l IH; simp [encode_list, decode_list, unpair_mkpair, encodek, *]⟩

@[simp] theorem encode_list_nil : encode (@nil α) = 0 := rfl
@[simp] theorem encode_list_cons (a : α) (l : list α) :
  encode (a :: l) = succ (mkpair (encode a) (encode l)) := rfl

@[simp] theorem decode_list_zero : decode (list α) 0 = some [] :=
show decode_list 0 = some [], by rw decode_list

@[simp] theorem decode_list_succ (v : ℕ) :
  decode (list α) (succ v) =
  (::) <$> decode α v.unpair.1 <*> decode (list α) v.unpair.2 :=
show decode_list (succ v) = _, begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e], refl
end

theorem length_le_encode : ∀ (l : list α), length l ≤ encode l
| [] := _root_.zero_le _
| (a :: l) := succ_le_succ $ (length_le_encode l).trans (right_le_mkpair _ _)

end list

section finset
variables [encodable α]

private def enle : α → α → Prop := encode ⁻¹'o (≤)

private lemma enle.is_linear_order : is_linear_order α enle :=
(rel_embedding.preimage ⟨encode, encode_injective⟩ (≤)).is_linear_order

private def decidable_enle (a b : α) : decidable (enle a b) :=
by unfold enle order.preimage; apply_instance

local attribute [instance] enle.is_linear_order decidable_enle

/-- Explicit encoding function for `multiset α` -/
def encode_multiset (s : multiset α) : ℕ :=
encode (s.sort enle)

/-- Explicit decoding function for `multiset α` -/
def decode_multiset (n : ℕ) : option (multiset α) :=
coe <$> decode (list α) n

/-- If `α` is encodable, then so is `multiset α`. -/
instance _root_.multiset.encodable : encodable (multiset α) :=
⟨encode_multiset, decode_multiset,
 λ s, by simp [encode_multiset, decode_multiset, encodek]⟩

end finset

/-- A listable type with decidable equality is encodable. -/
def encodable_of_list [decidable_eq α] (l : list α) (H : ∀ x, x ∈ l) : encodable α :=
⟨λ a, index_of a l, l.nth, λ a, index_of_nth (H _)⟩

/-- A finite type is encodable. Because the encoding is not unique, we wrap it in `trunc` to
preserve computability. -/
def _root_.fintype.trunc_encodable (α : Type*) [decidable_eq α] [fintype α] : trunc (encodable α) :=
@@quot.rec_on_subsingleton _
  (λ s : multiset α, (∀ x:α, x ∈ s) → trunc (encodable α)) _
  finset.univ.1
  (λ l H, trunc.mk $ encodable_of_list l H)
  finset.mem_univ

/-- A noncomputable way to arbitrarily choose an ordering on a finite type.
It is not made into a global instance, since it involves an arbitrary choice.
This can be locally made into an instance with `local attribute [instance] fintype.to_encodable`. -/
noncomputable def _root_.fintype.to_encodable (α : Type*) [fintype α] : encodable α :=
by { classical, exact (fintype.trunc_encodable α).out }

/-- If `α` is encodable, then so is `vector α n`. -/
instance _root_.vector.encodable [encodable α] {n} : encodable (vector α n) := subtype.encodable

/-- If `α` is encodable, then so is `fin n → α`. -/
instance fin_arrow [encodable α] {n} : encodable (fin n → α) :=
of_equiv _ (equiv.vector_equiv_fin _ _).symm

instance fin_pi (n) (π : fin n → Type*) [∀ i, encodable (π i)] : encodable (Π i, π i) :=
of_equiv _ (equiv.pi_equiv_subtype_sigma (fin n) π)

/-- If `α` is encodable, then so is `array n α`. -/
instance _root_.array.encodable [encodable α] {n} : encodable (array n α) :=
of_equiv _ (equiv.array_equiv_fin _ _)

/-- If `α` is encodable, then so is `finset α`. -/
instance _root_.finset.encodable [encodable α] : encodable (finset α) :=
by haveI := decidable_eq_of_encodable α; exact
 of_equiv {s : multiset α // s.nodup}
  ⟨λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩

-- TODO: Unify with `fintype_pi` and find a better name
/-- When `α` is finite and `β` is encodable, `α → β` is encodable too. Because the encoding is not
unique, we wrap it in `trunc` to preserve computability. -/
def fintype_arrow (α : Type*) (β : Type*) [decidable_eq α] [fintype α] [encodable β] :
  trunc (encodable (α → β)) :=
(fintype.trunc_equiv_fin α).map $
  λ f, encodable.of_equiv (fin (fintype.card α) → β) $
  equiv.arrow_congr f (equiv.refl _)

/-- When `α` is finite and all `π a` are encodable, `Π a, π a` is encodable too. Because the
encoding is not unique, we wrap it in `trunc` to preserve computability. -/
def fintype_pi (α : Type*) (π : α → Type*) [decidable_eq α] [fintype α] [∀ a, encodable (π a)] :
  trunc (encodable (Π a, π a)) :=
(fintype.trunc_encodable α).bind $ λ a,
  (@fintype_arrow α (Σa, π a) _ _ (@sigma.encodable _ _ a _)).bind $ λ f,
  trunc.mk $ @encodable.of_equiv _ _ (@subtype.encodable _ _ f _) (equiv.pi_equiv_subtype_sigma α π)

/-- The elements of a `fintype` as a sorted list. -/
def sorted_univ (α) [fintype α] [encodable α] : list α :=
finset.univ.sort (encodable.encode' α ⁻¹'o (≤))

@[simp] theorem mem_sorted_univ {α} [fintype α] [encodable α] (x : α) : x ∈ sorted_univ α :=
(finset.mem_sort _).2 (finset.mem_univ _)

@[simp] theorem length_sorted_univ (α) [fintype α] [encodable α] :
  (sorted_univ α).length = fintype.card α :=
finset.length_sort _

@[simp]

@[simp] theorem sorted_univ_to_finset (α) [fintype α] [encodable α] [decidable_eq α] :
  (sorted_univ α).to_finset = finset.univ :=
finset.sort_to_finset _ _

/-- An encodable `fintype` is equivalent to the same size `fin`. -/
def fintype_equiv_fin {α} [fintype α] [encodable α] :
  α ≃ fin (fintype.card α) :=
begin
  haveI : decidable_eq α := encodable.decidable_eq_of_encodable _,
  transitivity,
  { exact ((sorted_univ_nodup α).nth_le_equiv_of_forall_mem_list _ mem_sorted_univ).symm },
  exact equiv.cast (congr_arg _ (length_sorted_univ α))
end

/-- If `α` and `β` are encodable and `α` is a fintype, then `α → β` is encodable as well. -/
instance fintype_arrow_of_encodable {α β : Type*} [encodable α] [fintype α] [encodable β] :
  encodable (α → β) :=
of_equiv (fin (fintype.card α) → β) $ equiv.arrow_congr fintype_equiv_fin (equiv.refl _)

end encodable

namespace denumerable
variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
open encodable

section list

theorem denumerable_list_aux : ∀ n : ℕ,
  ∃ a ∈ @decode_list α _ n, encode_list a = n
| 0        := by rw decode_list; exact ⟨_, rfl, rfl⟩
| (succ v) := begin
  cases e : unpair v with v₁ v₂,
  have h := unpair_right_le v,
  rw e at h,
  rcases have v₂ < succ v, from lt_succ_of_le h,
    denumerable_list_aux v₂ with ⟨a, h₁, h₂⟩,
  rw option.mem_def at h₁,
  use of_nat α v₁ :: a,
  simp [decode_list, e, h₂, h₁, encode_list, mkpair_unpair' e],
end

/-- If `α` is denumerable, then so is `list α`. -/
instance denumerable_list : denumerable (list α) := ⟨denumerable_list_aux⟩

@[simp] theorem list_of_nat_zero : of_nat (list α) 0 = [] :=
by rw [← @encode_list_nil α, of_nat_encode]

@[simp] theorem list_of_nat_succ (v : ℕ) :
  of_nat (list α) (succ v) =
  of_nat α v.unpair.1 :: of_nat (list α) v.unpair.2 :=
of_nat_of_decode $ show decode_list (succ v) = _,
begin
  cases e : unpair v with v₁ v₂,
  simp [decode_list, e],
  rw [show decode_list v₂ = decode (list α) v₂,
      from rfl, decode_eq_of_nat]; refl
end

end list

section multiset

/-- Outputs the list of differences of the input list, that is
`lower [a₁, a₂, ...] n = [a₁ - n, a₂ - a₁, ...]` -/
def lower : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower l m

/-- Outputs the list of partial sums of the input list, that is
`raise [a₁, a₂, ...] n = [n + a₁, n + a₁ + a₂, ...]` -/
def raise : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise l (m + n)

lemma lower_raise : ∀ l n, lower (raise l n) n = l
| []       n := rfl
| (m :: l) n := by rw [raise, lower, add_tsub_cancel_right, lower_raise]

lemma raise_lower : ∀ {l n}, list.sorted (≤) (n :: l) → raise (lower l n) n = l
| []       n h := rfl
| (m :: l) n h :=
  have n ≤ m, from list.rel_of_sorted_cons h _ (l.mem_cons_self _),
  by simp [raise, lower, tsub_add_cancel_of_le this, raise_lower h.of_cons]

lemma raise_chain : ∀ l n, list.chain (≤) n (raise l n)
| []       n := list.chain.nil
| (m :: l) n := list.chain.cons (nat.le_add_left _ _) (raise_chain _ _)

/-- `raise l n` is an non-decreasing sequence. -/
lemma raise_sorted : ∀ l n, list.sorted (≤) (raise l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@le_trans _ _)).1 (raise_chain _ _)

/-- If `α` is denumerable, then so is `multiset α`. Warning: this is *not* the same encoding as used
in `multiset.encodable`. -/
instance multiset : denumerable (multiset α) := mk' ⟨
  λ s : multiset α, encode $ lower ((s.map encode).sort (≤)) 0,
  λ n, multiset.map (of_nat α) (raise (of_nat (list ℕ) n) 0),
  λ s, by have := raise_lower
      (list.sorted_cons.2 ⟨λ n _, zero_le n, (s.map encode).sort_sorted _⟩);
    simp [-multiset.coe_map, this],
  λ n, by simp [-multiset.coe_map, list.merge_sort_eq_self _ (raise_sorted _ _), lower_raise]⟩

end multiset

section finset

/-- Outputs the list of differences minus one of the input list, that is
`lower' [a₁, a₂, a₃, ...] n = [a₁ - n, a₂ - a₁ - 1, a₃ - a₂ - 1, ...]`. -/
def lower' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m - n) :: lower' l (m + 1)

/-- Outputs the list of partial sums plus one of the input list, that is
`raise [a₁, a₂, a₃, ...] n = [n + a₁, n + a₁ + a₂ + 1, n + a₁ + a₂ + a₃ + 2, ...]`. Adding one each
time ensures the elements are distinct. -/
def raise' : list ℕ → ℕ → list ℕ
| []       n := []
| (m :: l) n := (m + n) :: raise' l (m + n + 1)

lemma lower_raise' : ∀ l n, lower' (raise' l n) n = l
| []       n := rfl
| (m :: l) n := by simp [raise', lower', add_tsub_cancel_right, lower_raise']

lemma raise_lower' : ∀ {l n}, (∀ m ∈ l, n ≤ m) → list.sorted (<) l → raise' (lower' l n) n = l
| []       n h₁ h₂ := rfl
| (m :: l) n h₁ h₂ :=
  have n ≤ m, from h₁ _ (l.mem_cons_self _),
  by simp [raise', lower', tsub_add_cancel_of_le this, raise_lower'
    (list.rel_of_sorted_cons h₂ : ∀ a ∈ l, m < a) h₂.of_cons]

lemma raise'_chain : ∀ l {m n}, m < n → list.chain (<) m (raise' l n)
| []       m n h := list.chain.nil
| (a :: l) m n h := list.chain.cons
  (lt_of_lt_of_le h (nat.le_add_left _ _)) (raise'_chain _ (lt_succ_self _))

/-- `raise' l n` is a strictly increasing sequence. -/
lemma raise'_sorted : ∀ l n, list.sorted (<) (raise' l n)
| []       n := list.sorted_nil
| (m :: l) n := (list.chain_iff_pairwise (@lt_trans _ _)).1
  (raise'_chain _ (lt_succ_self _))

/-- Makes `raise' l n` into a finset. Elements are distinct thanks to `raise'_sorted`. -/
def raise'_finset (l : list ℕ) (n : ℕ) : finset ℕ :=
⟨raise' l n, (raise'_sorted _ _).imp (@ne_of_lt _ _)⟩

/-- If `α` is denumerable, then so is `finset α`. Warning: this is *not* the same encoding as used
in `finset.encodable`. -/
instance finset : denumerable (finset α) := mk' ⟨
  λ s : finset α, encode $ lower' ((s.map (eqv α).to_embedding).sort (≤)) 0,
  λ n, finset.map (eqv α).symm.to_embedding (raise'_finset (of_nat (list ℕ) n) 0),
  λ s, finset.eq_of_veq $ by simp [-multiset.coe_map, raise'_finset,
    raise_lower' (λ n _, zero_le n) (finset.sort_sorted_lt _)],
  λ n, by simp [-multiset.coe_map, finset.map, raise'_finset, finset.sort,
    list.merge_sort_eq_self (≤) ((raise'_sorted _ _).imp (@le_of_lt _ _)),
    lower_raise']⟩

end finset

end denumerable

namespace equiv

/-- The type lists on unit is canonically equivalent to the natural numbers. -/
def list_unit_equiv : list unit ≃ ℕ :=
{ to_fun := list.length,
  inv_fun := list.repeat (),
  left_inv := λ u, list.length_injective (by simp),
  right_inv := λ n, list.length_repeat () n }

/-- `list ℕ` is equivalent to `ℕ`. -/
def list_nat_equiv_nat : list ℕ ≃ ℕ := denumerable.eqv _

/-- If `α` is equivalent to `ℕ`, then `list α` is equivalent to `α`. -/
def list_equiv_self_of_equiv_nat {α : Type} (e : α ≃ ℕ) : list α ≃ α :=
calc list α ≃ list ℕ : list_equiv_of_equiv e
        ... ≃ ℕ      : list_nat_equiv_nat
        ... ≃ α      : e.symm

end equiv


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.perm
import Mathlib.data.list.chain
import Mathlib.PostPort

universes u_1 uu

namespace Mathlib

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

namespace list

/-!
### The predicate `list.sorted`
-/

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted {α : Type u_1} (R : α → α → Prop) : List α → Prop :=
  pairwise

protected instance decidable_sorted {α : Type uu} {r : α → α → Prop} [DecidableRel r] (l : List α) : Decidable (sorted r l) :=
  list.decidable_pairwise l

@[simp] theorem sorted_nil {α : Type uu} {r : α → α → Prop} : sorted r [] :=
  pairwise.nil

theorem sorted_of_sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} : sorted r (a :: l) → sorted r l :=
  pairwise_of_pairwise_cons

theorem sorted.tail {α : Type uu} {r : α → α → Prop} {l : List α} (h : sorted r l) : sorted r (tail l) :=
  pairwise.tail h

theorem rel_of_sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} : sorted r (a :: l) → ∀ (b : α), b ∈ l → r a b :=
  rel_of_pairwise_cons

@[simp] theorem sorted_cons {α : Type uu} {r : α → α → Prop} {a : α} {l : List α} : sorted r (a :: l) ↔ (∀ (b : α), b ∈ l → r a b) ∧ sorted r l :=
  pairwise_cons

protected theorem sorted.nodup {α : Type uu} {r : α → α → Prop} [is_irrefl α r] {l : List α} (h : sorted r l) : nodup l :=
  pairwise.nodup h

theorem eq_of_perm_of_sorted {α : Type uu} {r : α → α → Prop} [is_antisymm α r] {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ := sorry

@[simp] theorem sorted_singleton {α : Type uu} {r : α → α → Prop} (a : α) : sorted r [a] :=
  pairwise_singleton r a

theorem nth_le_of_sorted_of_le {α : Type uu} {r : α → α → Prop} [is_refl α r] {l : List α} (h : sorted r l) {a : ℕ} {b : ℕ} {ha : a < length l} {hb : b < length l} (hab : a ≤ b) : r (nth_le l a ha) (nth_le l b hb) :=
  or.dcases_on (eq_or_lt_of_le hab) (fun (H : a = b) => eq.drec (fun (hab : a ≤ a) => refl (nth_le l a ha)) H hb hab)
    fun (H : a < b) => iff.mp pairwise_iff_nth_le h a b hb H

/-! ### Insertion sort -/

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) : List α → List α :=
  sorry

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α :=
  sorry

@[simp] theorem ordered_insert_nil {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) : ordered_insert r a [] = [a] :=
  rfl

theorem ordered_insert_length {α : Type uu} (r : α → α → Prop) [DecidableRel r] (L : List α) (a : α) : length (ordered_insert r a L) = length L + 1 := sorry

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
theorem ordered_insert_eq_take_drop {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) : ordered_insert r a l = take_while (fun (b : α) => ¬r a b) l ++ a :: drop_while (fun (b : α) => ¬r a b) l := sorry

theorem insertion_sort_cons_eq_take_drop {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) : insertion_sort r (a :: l) =
  take_while (fun (b : α) => ¬r a b) (insertion_sort r l) ++
    a :: drop_while (fun (b : α) => ¬r a b) (insertion_sort r l) :=
  ordered_insert_eq_take_drop r a (insertion_sort r l)

theorem perm_ordered_insert {α : Type uu} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) : ordered_insert r a l ~ a :: l := sorry

theorem ordered_insert_count {α : Type uu} (r : α → α → Prop) [DecidableRel r] [DecidableEq α] (L : List α) (a : α) (b : α) : count a (ordered_insert r b L) = count a L + ite (a = b) 1 0 := sorry

theorem perm_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) : insertion_sort r l ~ l := sorry

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
theorem sorted.insertion_sort_eq {α : Type uu} {r : α → α → Prop} [DecidableRel r] {l : List α} (h : sorted r l) : insertion_sort r l = l := sorry

theorem sorted.ordered_insert {α : Type uu} {r : α → α → Prop} [DecidableRel r] [is_total α r] [is_trans α r] (a : α) (l : List α) : sorted r l → sorted r (ordered_insert r a l) := sorry

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r] [is_trans α r] (l : List α) : sorted r (insertion_sort r l) := sorry

/-! ### Merge sort -/

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the

-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split {α : Type uu} : List α → List α × List α :=
  sorry

theorem split_cons_of_eq {α : Type uu} (a : α) {l : List α} {l₁ : List α} {l₂ : List α} (h : split l = (l₁, l₂)) : split (a :: l) = (a :: l₂, l₁) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (split (a :: l) = (a :: l₂, l₁))) (split.equations._eqn_2 a l)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (split._match_1 a (split l) = (a :: l₂, l₁))) h))
      (Eq.refl (split._match_1 a (l₁, l₂))))

theorem length_split_le {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} : split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l := sorry

theorem length_split_lt {α : Type uu} {a : α} {b : α} {l : List α} {l₁ : List α} {l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) : length l₁ < length (a :: b :: l) ∧ length l₂ < length (a :: b :: l) := sorry

theorem perm_split {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} : split l = (l₁, l₂) → l ~ l₁ ++ l₂ := sorry

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α → List α :=
  sorry

/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] : List α → List α :=
  sorry

theorem merge_sort_cons_cons {α : Type uu} (r : α → α → Prop) [DecidableRel r] {a : α} {b : α} {l : List α} {l₁ : List α} {l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) : merge_sort r (a :: b :: l) = merge r (merge_sort r l₁) (merge_sort r l₂) := sorry

theorem perm_merge {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) (l' : List α) : merge r l l' ~ l ++ l' := sorry

theorem perm_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) : merge_sort r l ~ l := sorry

@[simp] theorem length_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] (l : List α) : length (merge_sort r l) = length l :=
  perm.length_eq (perm_merge_sort r l)

theorem sorted.merge {α : Type uu} {r : α → α → Prop} [DecidableRel r] [is_total α r] [is_trans α r] {l : List α} {l' : List α} : sorted r l → sorted r l' → sorted r (merge r l l') := sorry

theorem sorted_merge_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r] [is_trans α r] (l : List α) : sorted r (merge_sort r l) := sorry

theorem merge_sort_eq_self {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r] [is_trans α r] [is_antisymm α r] {l : List α} : sorted r l → merge_sort r l = l :=
  eq_of_perm_of_sorted (perm_merge_sort r l) (sorted_merge_sort r l)

theorem merge_sort_eq_insertion_sort {α : Type uu} (r : α → α → Prop) [DecidableRel r] [is_total α r] [is_trans α r] [is_antisymm α r] (l : List α) : merge_sort r l = insertion_sort r l :=
  eq_of_perm_of_sorted (perm.trans (perm_merge_sort r l) (perm.symm (perm_insertion_sort r l))) (sorted_merge_sort r l)
    (sorted_insertion_sort r l)