/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.fin_category
import category_theory.limits.cones
import category_theory.adjunction.basic
import category_theory.category.preorder
import category_theory.category.ulift

/-!
# Filtered categories

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

A category is filtered if every finite diagram admits a cocone.
We give a simple characterisation of this condition as
1. for every pair of objects there exists another object "to the right",
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal, and
3. there exists some object.

Filtered colimits are often better behaved than arbitrary colimits.
See `category_theory/limits/types` for some details.

Filtered categories are nice because colimits indexed by filtered categories tend to be
easier to describe than general colimits (and more often preserved by functors).

In this file we show that any functor from a finite category to a filtered category admits a cocone:
* `cocone_nonempty [fin_category J] [is_filtered C] (F : J ⥤ C) : nonempty (cocone F)`
More generally,
for any finite collection of objects and morphisms between them in a filtered category
(even if not closed under composition) there exists some object `Z` receiving maps from all of them,
so that all the triangles (one edge from the finite set, two from morphisms to `Z`) commute.
This formulation is often more useful in practice and is available via `sup_exists`,
which takes a finset of objects, and an indexed family (indexed by source and target)
of finsets of morphisms.

Furthermore, we give special support for two diagram categories: The `bowtie` and the `tulip`.
This is because these shapes show up in the proofs that forgetful functors of algebraic categories
(e.g. `Mon`, `CommRing`, ...) preserve filtered colimits.

All of the above API, except for the `bowtie` and the `tulip`, is also provided for cofiltered
categories.

## See also
In `category_theory.limits.filtered_colimit_commutes_finite_limit` we show that filtered colimits
commute with finite limits.

-/

open function

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes w v v₁ u u₁ u₂

namespace category_theory

variables (C : Type u) [category.{v} C]

/--
A category `is_filtered_or_empty` if
1. for every pair of objects there exists another object "to the right", and
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal.
-/
class is_filtered_or_empty : Prop :=
(cocone_objs : ∀ (X Y : C), ∃ Z (f : X ⟶ Z) (g : Y ⟶ Z), true)
(cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ Z (h : Y ⟶ Z), f ≫ h = g ≫ h)

/--
A category `is_filtered` if
1. for every pair of objects there exists another object "to the right",
2. for every pair of parallel morphisms there exists a morphism to the right so the compositions
   are equal, and
3. there exists some object.

See <https://stacks.math.columbia.edu/tag/002V>. (They also define a diagram being filtered.)
-/
class is_filtered extends is_filtered_or_empty C : Prop :=
[nonempty : nonempty C]

@[priority 100]
instance is_filtered_or_empty_of_semilattice_sup
  (α : Type u) [semilattice_sup α] : is_filtered_or_empty α :=
{ cocone_objs := λ X Y, ⟨X ⊔ Y, hom_of_le le_sup_left, hom_of_le le_sup_right, trivial⟩,
  cocone_maps := λ X Y f g, ⟨Y, 𝟙 _, (by ext)⟩, }

@[priority 100]
instance is_filtered_of_semilattice_sup_nonempty
  (α : Type u) [semilattice_sup α] [nonempty α] : is_filtered α := {}

@[priority 100]
instance is_filtered_or_empty_of_directed_le (α : Type u) [preorder α] [is_directed α (≤)] :
  is_filtered_or_empty α :=
{ cocone_objs := λ X Y, let ⟨Z, h1, h2⟩ := exists_ge_ge X Y in
    ⟨Z, hom_of_le h1, hom_of_le h2, trivial⟩,
  cocone_maps := λ X Y f g, ⟨Y, 𝟙 _, by simp⟩ }

@[priority 100]
instance is_filtered_of_directed_le_nonempty (α : Type u) [preorder α] [is_directed α (≤)]
  [nonempty α] :
  is_filtered α := {}

-- Sanity checks
example (α : Type u) [semilattice_sup α] [order_bot α] : is_filtered α := by apply_instance
example (α : Type u) [semilattice_sup α] [order_top α] : is_filtered α := by apply_instance

instance : is_filtered (discrete punit) :=
{ cocone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩,
  cocone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩,
  nonempty := ⟨⟨punit.star⟩⟩ }

namespace is_filtered

section allow_empty

variables {C} [is_filtered_or_empty C]

lemma cocone_objs : ∀ (X Y : C), ∃ Z (f : X ⟶ Z) (g : Y ⟶ Z), true :=
is_filtered_or_empty.cocone_objs
lemma cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ Z (h : Y ⟶ Z), f ≫ h = g ≫ h :=
is_filtered_or_empty.cocone_maps

/--
`max j j'` is an arbitrary choice of object to the right of both `j` and `j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def max (j j' : C) : C :=
(cocone_objs j j').some

/--
`left_to_max j j'` is an arbitrary choice of morphism from `j` to `max j j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def left_to_max (j j' : C) : j ⟶ max j j' :=
(cocone_objs j j').some_spec.some

/--
`right_to_max j j'` is an arbitrary choice of morphism from `j'` to `max j j'`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def right_to_max (j j' : C) : j' ⟶ max j j' :=
(cocone_objs j j').some_spec.some_spec.some

/--
`coeq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object
which admits a morphism `coeq_hom f f' : j' ⟶ coeq f f'` such that
`coeq_condition : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq {j j' : C} (f f' : j ⟶ j') : C :=
(cocone_maps f f').some

/--
`coeq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism
`coeq_hom f f' : j' ⟶ coeq f f'` such that
`coeq_condition : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq_hom {j j' : C} (f f' : j ⟶ j') : j' ⟶ coeq f f' :=
(cocone_maps f f').some_spec.some

/--
`coeq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that
`f ≫ coeq_hom f f' = f' ≫ coeq_hom f f'`.
-/
@[simp, reassoc]
lemma coeq_condition {j j' : C} (f f' : j ⟶ j') : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f' :=
(cocone_maps f f').some_spec.some_spec

end allow_empty

section nonempty

open category_theory.limits

variables {C} [is_filtered C]

/--
Any finite collection of objects in a filtered category has an object "to the right".
-/
lemma sup_objs_exists (O : finset C) : ∃ (S : C), ∀ {X}, X ∈ O → _root_.nonempty (X ⟶ S) :=
begin
  classical,
  apply finset.induction_on O,
  { exact ⟨is_filtered.nonempty.some, (by rintros - ⟨⟩)⟩, },
  { rintros X O' nm ⟨S', w'⟩,
    use max X S',
    rintros Y mY,
    obtain rfl|h := eq_or_ne Y X,
    { exact ⟨left_to_max _ _⟩, },
    { exact ⟨(w' (finset.mem_of_mem_insert_of_ne mY h)).some ≫ right_to_max _ _⟩, }, }
end

variables (O : finset C) (H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y))

/--
Given any `finset` of objects `{X, ...}` and
indexed collection of `finset`s of morphisms `{f, ...}` in `C`,
there exists an object `S`, with a morphism `T X : X ⟶ S` from each `X`,
such that the triangles commute: `f ≫ T Y = T X`, for `f : X ⟶ Y` in the `finset`.
-/
lemma sup_exists :
  ∃ (S : C) (T : Π {X : C}, X ∈ O → (X ⟶ S)), ∀ {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y},
    (⟨X, Y, mX, mY, f⟩ : (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H → f ≫ T mY = T mX :=
begin
  classical,
  apply finset.induction_on H,
  { obtain ⟨S, f⟩ := sup_objs_exists O,
    refine ⟨S, λ X mX, (f mX).some, _⟩,
    rintros - - - - - ⟨⟩, },
  { rintros ⟨X, Y, mX, mY, f⟩ H' nmf ⟨S', T', w'⟩,
    refine ⟨coeq (f ≫ T' mY) (T' mX), λ Z mZ, T' mZ ≫ coeq_hom (f ≫ T' mY) (T' mX), _⟩,
    intros X' Y' mX' mY' f' mf',
    rw [←category.assoc],
    by_cases h : X = X' ∧ Y = Y',
    { rcases h with ⟨rfl, rfl⟩,
      by_cases hf : f = f',
      { subst hf,
        apply coeq_condition, },
      { rw @w' _ _ mX mY f' (by simpa [hf ∘ eq.symm] using mf') }, },
    { rw @w' _ _ mX' mY' f' _,
      apply finset.mem_of_mem_insert_of_ne mf',
      contrapose! h,
      obtain ⟨rfl, h⟩ := h,
      rw [heq_iff_eq, psigma.mk.inj_iff] at h,
      exact ⟨rfl, h.1.symm⟩ }, },
end

/--
An arbitrary choice of object "to the right"
of a finite collection of objects `O` and morphisms `H`,
making all the triangles commute.
-/
noncomputable
def sup : C :=
(sup_exists O H).some

/--
The morphisms to `sup O H`.
-/
noncomputable
def to_sup {X : C} (m : X ∈ O) :
  X ⟶ sup O H :=
(sup_exists O H).some_spec.some m

/--
The triangles of consisting of a morphism in `H` and the maps to `sup O H` commute.
-/
lemma to_sup_commutes
  {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y}
  (mf : (⟨X, Y, mX, mY, f⟩ : Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) ∈ H) :
  f ≫ to_sup O H mY = to_sup O H mX :=
(sup_exists O H).some_spec.some_spec mX mY mf

variables {J : Type v} [small_category J] [fin_category J]

/--
If we have `is_filtered C`, then for any functor `F : J ⥤ C` with `fin_category J`,
there exists a cocone over `F`.
-/
lemma cocone_nonempty (F : J ⥤ C) : _root_.nonempty (cocone F) :=
begin
  classical,
  let O := (finset.univ.image F.obj),
  let H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ X : J, finset.univ.bUnion (λ Y : J, finset.univ.image (λ f : X ⟶ Y,
      ⟨F.obj X, F.obj Y, by simp, by simp, F.map f⟩))),
  obtain ⟨Z, f, w⟩ := sup_exists O H,
  refine ⟨⟨Z, ⟨λ X, f (by simp), _⟩⟩⟩,
  intros j j' g,
  dsimp,
  simp only [category.comp_id],
  apply w,
  simp only [finset.mem_univ, finset.mem_bUnion, exists_and_distrib_left,
    exists_prop_of_true, finset.mem_image],
  exact ⟨j, rfl, j', g, (by simp)⟩,
end

/--
An arbitrary choice of cocone over `F : J ⥤ C`, for `fin_category J` and `is_filtered C`.
-/
noncomputable def cocone (F : J ⥤ C) : cocone F :=
(cocone_nonempty F).some

variables {D : Type u₁} [category.{v₁} D]

/--
If `C` is filtered, and we have a functor `R : C ⥤ D` with a left adjoint, then `D` is filtered.
-/
lemma of_right_adjoint {L : D ⥤ C} {R : C ⥤ D} (h : L ⊣ R) : is_filtered D :=
{ cocone_objs := λ X Y,
    ⟨_, h.hom_equiv _ _ (left_to_max _ _), h.hom_equiv _ _ (right_to_max _ _), ⟨⟩⟩,
  cocone_maps := λ X Y f g,
    ⟨_, h.hom_equiv _ _ (coeq_hom _ _),
     by rw [← h.hom_equiv_naturality_left, ← h.hom_equiv_naturality_left, coeq_condition]⟩,
  nonempty := is_filtered.nonempty.map R.obj }

/-- If `C` is filtered, and we have a right adjoint functor `R : C ⥤ D`, then `D` is filtered. -/
lemma of_is_right_adjoint (R : C ⥤ D) [is_right_adjoint R] : is_filtered D :=
of_right_adjoint (adjunction.of_right_adjoint R)

/-- Being filtered is preserved by equivalence of categories. -/
lemma of_equivalence (h : C ≌ D) : is_filtered D :=
of_right_adjoint h.symm.to_adjunction

end nonempty

section special_shapes

variables {C} [is_filtered_or_empty C]

/--
`max₃ j₁ j₂ j₃` is an arbitrary choice of object to the right of `j₁`, `j₂` and `j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def max₃ (j₁ j₂ j₃ : C) : C := max (max j₁ j₂) j₃

/--
`first_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₁` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def first_to_max₃ (j₁ j₂ j₃ : C) : j₁ ⟶ max₃ j₁ j₂ j₃ :=
left_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃

/--
`second_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₂` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def second_to_max₃ (j₁ j₂ j₃ : C) : j₂ ⟶ max₃ j₁ j₂ j₃ :=
right_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃

/--
`third_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₃` to `max₃ j₁ j₂ j₃`,
whose existence is ensured by `is_filtered`.
-/
noncomputable def third_to_max₃ (j₁ j₂ j₃ : C) : j₃ ⟶ max₃ j₁ j₂ j₃ :=
right_to_max (max j₁ j₂) j₃

/--
`coeq₃ f g h`, for morphisms `f g h : j₁ ⟶ j₂`, is an arbitrary choice of object
which admits a morphism `coeq₃_hom f g h : j₂ ⟶ coeq₃ f g h` such that
`coeq₃_condition₁`, `coeq₃_condition₂` and `coeq₃_condition₃` are satisfied.
Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq₃ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : C :=
coeq (coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h))
  (coeq_hom g h ≫ right_to_max (coeq f g) (coeq g h))

/--
`coeq₃_hom f g h`, for morphisms `f g h : j₁ ⟶ j₂`, is an arbitrary choice of morphism
`j₂ ⟶ coeq₃ f g h` such that `coeq₃_condition₁`, `coeq₃_condition₂` and `coeq₃_condition₃`
are satisfied. Its existence is ensured by `is_filtered`.
-/
noncomputable def coeq₃_hom {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : j₂ ⟶ coeq₃ f g h :=
coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h) ≫
coeq_hom (coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h))
  (coeq_hom g h ≫ right_to_max (coeq f g) (coeq g h))

lemma coeq₃_condition₁ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  f ≫ coeq₃_hom f g h = g ≫ coeq₃_hom f g h :=
by rw [coeq₃_hom, reassoc_of (coeq_condition f g)]

lemma coeq₃_condition₂ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  g ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h :=
begin
  dsimp [coeq₃_hom],
  slice_lhs 2 4 { rw [← category.assoc, coeq_condition _ _] },
  slice_rhs 2 4 { rw [← category.assoc, coeq_condition _ _] },
  slice_lhs 1 3 { rw [← category.assoc, coeq_condition _ _] },
  simp only [category.assoc],
end

lemma coeq₃_condition₃ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) :
  f ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h :=
eq.trans (coeq₃_condition₁ f g h) (coeq₃_condition₂ f g h)

/-- For every span `j ⟵ i ⟶ j'`, there
   exists a cocone `j ⟶ k ⟵ j'` such that the square commutes. -/
lemma span {i j j' : C} (f : i ⟶ j) (f' : i ⟶ j') :
  ∃ (k : C) (g : j ⟶ k) (g' : j' ⟶ k), f ≫ g = f' ≫ g' :=
let ⟨K, G, G', _⟩ := cocone_objs j j', ⟨k, e, he⟩ := cocone_maps (f ≫ G) (f' ≫ G') in
⟨k, G ≫ e, G' ≫ e, by simpa only [← category.assoc]⟩

/--
Given a "bowtie" of morphisms
```
 j₁   j₂
 |\  /|
 | \/ |
 | /\ |
 |/  \∣
 vv  vv
 k₁  k₂
```
in a filtered category, we can construct an object `s` and two morphisms from `k₁` and `k₂` to `s`,
making the resulting squares commute.
-/
lemma bowtie {j₁ j₂ k₁ k₂ : C}
  (f₁ : j₁ ⟶ k₁) (g₁ : j₁ ⟶ k₂) (f₂ : j₂ ⟶ k₁) (g₂ : j₂ ⟶ k₂) :
  ∃ (s : C) (α : k₁ ⟶ s) (β : k₂ ⟶ s), f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = g₂ ≫ β :=
begin
  obtain ⟨t, k₁t, k₂t, ht⟩ := span f₁ g₁,
  obtain ⟨s, ts, hs⟩ := cocone_maps (f₂ ≫ k₁t) (g₂ ≫ k₂t),
  simp_rw category.assoc at hs,
  exact ⟨s, k₁t ≫ ts, k₂t ≫ ts, by rw reassoc_of ht, hs⟩,
end

/--
Given a "tulip" of morphisms
```
 j₁    j₂    j₃
 |\   / \   / |
 | \ /   \ /  |
 |  vv    vv  |
 \  k₁    k₂ /
  \         /
   \       /
    \     /
     \   /
      v v
       l
```
in a filtered category, we can construct an object `s` and three morphisms from `k₁`, `k₂` and `l`
to `s`, making the resulting squares commute.
-/
lemma tulip {j₁ j₂ j₃ k₁ k₂ l : C} (f₁ : j₁ ⟶ k₁) (f₂ : j₂ ⟶ k₁) (f₃ : j₂ ⟶ k₂) (f₄ : j₃ ⟶ k₂)
  (g₁ : j₁ ⟶ l) (g₂ : j₃ ⟶ l) :
  ∃ (s : C) (α : k₁ ⟶ s) (β : l ⟶ s) (γ : k₂ ⟶ s),
    f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = f₃ ≫ γ ∧ f₄ ≫ γ = g₂ ≫ β :=
begin
  obtain ⟨l', k₁l, k₂l, hl⟩ := span f₂ f₃,
  obtain ⟨s, ls, l's, hs₁, hs₂⟩ := bowtie g₁ (f₁ ≫ k₁l) g₂ (f₄ ≫ k₂l),
  refine ⟨s, k₁l ≫ l's, ls, k₂l ≫ l's, _, by rw reassoc_of hl, _⟩;
  simp only [hs₁, hs₂, category.assoc],
end

end special_shapes

end is_filtered

/--
A category `is_cofiltered_or_empty` if
1. for every pair of objects there exists another object "to the left", and
2. for every pair of parallel morphisms there exists a morphism to the left so the compositions
   are equal.
-/
class is_cofiltered_or_empty : Prop :=
(cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true)
(cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g)

/--
A category `is_cofiltered` if
1. for every pair of objects there exists another object "to the left",
2. for every pair of parallel morphisms there exists a morphism to the left so the compositions
   are equal, and
3. there exists some object.

See <https://stacks.math.columbia.edu/tag/04AZ>.
-/
class is_cofiltered extends is_cofiltered_or_empty C : Prop :=
[nonempty : nonempty C]

@[priority 100]
instance is_cofiltered_or_empty_of_semilattice_inf
  (α : Type u) [semilattice_inf α] : is_cofiltered_or_empty α :=
{ cone_objs := λ X Y, ⟨X ⊓ Y, hom_of_le inf_le_left, hom_of_le inf_le_right, trivial⟩,
  cone_maps := λ X Y f g, ⟨X, 𝟙 _, (by ext)⟩, }

@[priority 100]
instance is_cofiltered_of_semilattice_inf_nonempty
  (α : Type u) [semilattice_inf α] [nonempty α] : is_cofiltered α := {}

@[priority 100]
instance is_cofiltered_or_empty_of_directed_ge (α : Type u) [preorder α]
  [is_directed α (≥)] :
  is_cofiltered_or_empty α :=
{ cone_objs := λ X Y, let ⟨Z, hX, hY⟩ := exists_le_le X Y in
    ⟨Z, hom_of_le hX, hom_of_le hY, trivial⟩,
  cone_maps := λ X Y f g, ⟨X, 𝟙 _, by simp⟩ }

@[priority 100]
instance is_cofiltered_of_directed_ge_nonempty (α : Type u) [preorder α] [is_directed α (≥)]
  [nonempty α] :
  is_cofiltered α := {}

-- Sanity checks
example (α : Type u) [semilattice_inf α] [order_bot α] : is_cofiltered α := by apply_instance
example (α : Type u) [semilattice_inf α] [order_top α] : is_cofiltered α := by apply_instance

instance : is_cofiltered (discrete punit) :=
{ cone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩,
  cone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩,
  nonempty := ⟨⟨punit.star⟩⟩ }

namespace is_cofiltered

section allow_empty

variables {C} [is_cofiltered_or_empty C]

lemma cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true := is_cofiltered_or_empty.cone_objs
lemma cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g :=
is_cofiltered_or_empty.cone_maps

/--
`min j j'` is an arbitrary choice of object to the left of both `j` and `j'`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min (j j' : C) : C :=
(cone_objs j j').some

/--
`min_to_left j j'` is an arbitrary choice of morphism from `min j j'` to `j`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min_to_left (j j' : C) : min j j' ⟶ j :=
(cone_objs j j').some_spec.some

/--
`min_to_right j j'` is an arbitrary choice of morphism from `min j j'` to `j'`,
whose existence is ensured by `is_cofiltered`.
-/
noncomputable def min_to_right (j j' : C) : min j j' ⟶ j' :=
(cone_objs j j').some_spec.some_spec.some

/--
`eq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object
which admits a morphism `eq_hom f f' : eq f f' ⟶ j` such that
`eq_condition : eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
Its existence is ensured by `is_cofiltered`.
-/
noncomputable def eq {j j' : C} (f f' : j ⟶ j') : C :=
(cone_maps f f').some

/--
`eq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism
`eq_hom f f' : eq f f' ⟶ j` such that
`eq_condition : eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
Its existence is ensured by `is_cofiltered`.
-/
noncomputable def eq_hom {j j' : C} (f f' : j ⟶ j') : eq f f' ⟶ j :=
(cone_maps f f').some_spec.some

/--
`eq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that
`eq_hom f f' ≫ f = eq_hom f f' ≫ f'`.
-/
@[simp, reassoc]
lemma eq_condition {j j' : C} (f f' : j ⟶ j') : eq_hom f f' ≫ f = eq_hom f f' ≫ f' :=
(cone_maps f f').some_spec.some_spec

/-- For every cospan `j ⟶ i ⟵ j'`,
 there exists a cone `j ⟵ k ⟶ j'` such that the square commutes. -/
lemma cospan {i j j' : C} (f : j ⟶ i) (f' : j' ⟶ i) :
  ∃ (k : C) (g : k ⟶ j) (g' : k ⟶ j'), g ≫ f = g' ≫ f' :=
let ⟨K, G, G', _⟩ := cone_objs j j', ⟨k, e, he⟩ := cone_maps (G ≫ f) (G' ≫ f') in
⟨k, e ≫ G, e ≫ G', by simpa only [category.assoc] using he⟩

lemma _root_.category_theory.functor.ranges_directed (F : C ⥤ Type*) (j : C) :
  directed (⊇) (λ (f : Σ' i, i ⟶ j), set.range (F.map f.2)) :=
λ ⟨i, ij⟩ ⟨k, kj⟩, let ⟨l, li, lk, e⟩ := cospan ij kj in
by refine ⟨⟨l, lk ≫ kj⟩, e ▸ _, _⟩; simp_rw F.map_comp; apply set.range_comp_subset_range

end allow_empty

section nonempty

open category_theory.limits

variables {C} [is_cofiltered C]

/--
Any finite collection of objects in a cofiltered category has an object "to the left".
-/
lemma inf_objs_exists (O : finset C) : ∃ (S : C), ∀ {X}, X ∈ O → _root_.nonempty (S ⟶ X) :=
begin
  classical,
  apply finset.induction_on O,
  { exact ⟨is_cofiltered.nonempty.some, (by rintros - ⟨⟩)⟩, },
  { rintros X O' nm ⟨S', w'⟩,
    use min X S',
    rintros Y mY,
    obtain rfl|h := eq_or_ne Y X,
    { exact ⟨min_to_left _ _⟩, },
    { exact ⟨min_to_right _ _ ≫ (w' (finset.mem_of_mem_insert_of_ne mY h)).some⟩, }, }
end

variables (O : finset C) (H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y))

/--
Given any `finset` of objects `{X, ...}` and
indexed collection of `finset`s of morphisms `{f, ...}` in `C`,
there exists an object `S`, with a morphism `T X : S ⟶ X` from each `X`,
such that the triangles commute: `T X ≫ f = T Y`, for `f : X ⟶ Y` in the `finset`.
-/
lemma inf_exists :
  ∃ (S : C) (T : Π {X : C}, X ∈ O → (S ⟶ X)), ∀ {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y},
    (⟨X, Y, mX, mY, f⟩ : (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H → T mX ≫ f = T mY :=
begin
  classical,
  apply finset.induction_on H,
  { obtain ⟨S, f⟩ := inf_objs_exists O,
    refine ⟨S, λ X mX, (f mX).some, _⟩,
    rintros - - - - - ⟨⟩, },
  { rintros ⟨X, Y, mX, mY, f⟩ H' nmf ⟨S', T', w'⟩,
    refine ⟨eq (T' mX ≫ f) (T' mY), λ Z mZ, eq_hom (T' mX ≫ f) (T' mY) ≫ T' mZ, _⟩,
    intros X' Y' mX' mY' f' mf',
    rw [category.assoc],
    by_cases h : X = X' ∧ Y = Y',
    { rcases h with ⟨rfl, rfl⟩,
      by_cases hf : f = f',
      { subst hf,
        apply eq_condition, },
      { rw @w' _ _ mX mY f' (by simpa [hf ∘ eq.symm] using mf') }, },
    { rw @w' _ _ mX' mY' f' _,
      apply finset.mem_of_mem_insert_of_ne mf',
      contrapose! h,
      obtain ⟨rfl, h⟩ := h,
      rw [heq_iff_eq, psigma.mk.inj_iff] at h,
      exact ⟨rfl, h.1.symm⟩ }, },
end

/--
An arbitrary choice of object "to the left"
of a finite collection of objects `O` and morphisms `H`,
making all the triangles commute.
-/
noncomputable
def inf : C :=
(inf_exists O H).some

/--
The morphisms from `inf O H`.
-/
noncomputable
def inf_to {X : C} (m : X ∈ O) :
  inf O H ⟶ X :=
(inf_exists O H).some_spec.some m

/--
The triangles consisting of a morphism in `H` and the maps from `inf O H` commute.
-/
lemma inf_to_commutes
  {X Y : C} (mX : X ∈ O) (mY : Y ∈ O) {f : X ⟶ Y}
  (mf : (⟨X, Y, mX, mY, f⟩ : Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) ∈ H) :
  inf_to O H mX ≫ f = inf_to O H mY :=
(inf_exists O H).some_spec.some_spec mX mY mf

variables {J : Type w} [small_category J] [fin_category J]

/--
If we have `is_cofiltered C`, then for any functor `F : J ⥤ C` with `fin_category J`,
there exists a cone over `F`.
-/
lemma cone_nonempty (F : J ⥤ C) : _root_.nonempty (cone F) :=
begin
  classical,
  let O := (finset.univ.image F.obj),
  let H : finset (Σ' (X Y : C) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ X : J, finset.univ.bUnion (λ Y : J, finset.univ.image (λ f : X ⟶ Y,
      ⟨F.obj X, F.obj Y, by simp, by simp, F.map f⟩))),
  obtain ⟨Z, f, w⟩ := inf_exists O H,
  refine ⟨⟨Z, ⟨λ X, f (by simp), _⟩⟩⟩,
  intros j j' g,
  dsimp,
  simp only [category.id_comp],
  symmetry,
  apply w,
  simp only [finset.mem_univ, finset.mem_bUnion, exists_and_distrib_left,
    exists_prop_of_true, finset.mem_image],
  exact ⟨j, rfl, j', g, (by simp)⟩,
end

/--
An arbitrary choice of cone over `F : J ⥤ C`, for `fin_category J` and `is_cofiltered C`.
-/
noncomputable def cone (F : J ⥤ C) : cone F :=
(cone_nonempty F).some

variables {D : Type u₁} [category.{v₁} D]

/--
If `C` is cofiltered, and we have a functor `L : C ⥤ D` with a right adjoint,
then `D` is cofiltered.
-/
lemma of_left_adjoint {L : C ⥤ D} {R : D ⥤ C} (h : L ⊣ R) : is_cofiltered D :=
{ cone_objs := λ X Y,
    ⟨L.obj (min (R.obj X) (R.obj Y)),
      (h.hom_equiv _ X).symm (min_to_left _ _), (h.hom_equiv _ Y).symm (min_to_right _ _), ⟨⟩⟩,
  cone_maps := λ X Y f g,
    ⟨L.obj (eq (R.map f) (R.map g)), (h.hom_equiv _ _).symm (eq_hom _ _),
     by rw [← h.hom_equiv_naturality_right_symm, ← h.hom_equiv_naturality_right_symm,
       eq_condition]⟩,
  nonempty := is_cofiltered.nonempty.map L.obj }

/-- If `C` is cofiltered, and we have a left adjoint functor `L : C ⥤ D`, then `D` is cofiltered. -/

/-- Being cofiltered is preserved by equivalence of categories. -/
lemma of_equivalence (h : C ≌ D) : is_cofiltered D :=
of_left_adjoint h.to_adjunction

end nonempty

end is_cofiltered

section opposite
open opposite

instance is_cofiltered_op_of_is_filtered [is_filtered C] : is_cofiltered Cᵒᵖ :=
{ cone_objs := λ X Y, ⟨op (is_filtered.max X.unop Y.unop),
    (is_filtered.left_to_max _ _).op, (is_filtered.right_to_max _ _).op, trivial⟩,
  cone_maps := λ X Y f g, ⟨op (is_filtered.coeq f.unop g.unop),
    (is_filtered.coeq_hom _ _).op, begin
      rw [(show f = f.unop.op, by simp), (show g = g.unop.op, by simp),
        ← op_comp, ← op_comp],
      congr' 1,
      exact is_filtered.coeq_condition f.unop g.unop,
    end⟩,
  nonempty := ⟨op is_filtered.nonempty.some⟩ }

instance is_filtered_op_of_is_cofiltered [is_cofiltered C] : is_filtered Cᵒᵖ :=
{ cocone_objs := λ X Y, ⟨op (is_cofiltered.min X.unop Y.unop),
    (is_cofiltered.min_to_left X.unop Y.unop).op,
    (is_cofiltered.min_to_right X.unop Y.unop).op, trivial⟩,
  cocone_maps := λ X Y f g, ⟨op (is_cofiltered.eq f.unop g.unop),
    (is_cofiltered.eq_hom f.unop g.unop).op, begin
      rw [(show f = f.unop.op, by simp), (show g = g.unop.op, by simp),
        ← op_comp, ← op_comp],
      congr' 1,
      exact is_cofiltered.eq_condition f.unop g.unop,
    end⟩,
  nonempty := ⟨op is_cofiltered.nonempty.some⟩ }

end opposite

section ulift

instance [is_filtered C] : is_filtered (ulift.{u₂} C) :=
is_filtered.of_equivalence ulift.equivalence

instance [is_cofiltered C] : is_cofiltered (ulift.{u₂} C) :=
is_cofiltered.of_equivalence ulift.equivalence

instance [is_filtered C] : is_filtered (ulift_hom C) :=
is_filtered.of_equivalence ulift_hom.equiv

instance [is_cofiltered C] : is_cofiltered (ulift_hom C) :=
is_cofiltered.of_equivalence ulift_hom.equiv

instance [is_filtered C] : is_filtered (as_small C) :=
is_filtered.of_equivalence as_small.equiv

instance [is_cofiltered C] : is_cofiltered (as_small C) :=
is_cofiltered.of_equivalence as_small.equiv

end ulift

end category_theory


/- import rel_hoare

namespace arrcp

open parlang
open parlang.kernel

def tstate := string → ℕ

def state.update (name : string) (val : ℕ) (s : tstate) : tstate :=
λn, if n = name then val else s n

notation s ` & ` n ` ::= ` v := state.update n v s

def init := λ n : ℕ, λ name, if name = "tid" then n else 0

def arrcp₁ : program tstate (λ n : ℕ, ℕ) := program.intro (λ m : memory (λ n : ℕ, ℕ), m 0) (
    kernel.load (λ s, ⟨0, λ a, s & "n" ::= a⟩) ;;               -- load n to thread tlocal
    kernel.load (λ s, ⟨1 + s "tid", λ a, s & "temp" ::= a⟩) ;;  -- load from array a
    kernel.store (λ s, ⟨1 + s "n" + s "tid", s "temp"⟩)         -- store to array b
)

def arrcp₂ : program tstate (λ n : ℕ, ℕ) := program.intro (λ m : memory (λ n : ℕ, ℕ), 10) (
    kernel.load (λ s, ⟨0, λ a, s & "n" ::= a⟩) ;;               -- load n to thread tlocal
    kernel.compute (λ s, s & "i" ::= s "tid") ;;
    kernel.loop (λ s, s "i" < s "n") (
        kernel.load (λ s, ⟨1 + s "i", λ a, s & "temp" ::= a⟩) ;;-- load from array a
        kernel.store (λ s, ⟨1 + s "n" + s "i", s "temp"⟩) ;;    -- store to array b
        kernel.compute (λ s, s & "i" ::= s "i" + 10)
    )
)

lemma arrcprel : rel_hoare_program init init eq arrcp₁ arrcp₂ eq := begin
    unfold arrcp₁ arrcp₂,
    apply rel_kernel_to_program,
    apply single_step_left ((λ (n₁ : ℕ) (s₁ : state n₁ (string → ℕ) (λ (n : ℕ), ℕ)) (ac₁ : vector bool n₁) (n₂ : ℕ)
     (s₂ : state n₂ (string → ℕ) (λ (n : ℕ), ℕ)) (ac₂ : vector bool n₂),
       ∃ (m₁ m₂ : memory (λ (n : ℕ), ℕ)),
         state.syncable s₁ m₁ ∧
           state.syncable s₂ m₂ ∧
             n₁ = m₁ 0 ∧
               n₂ = 10 ∧
                (∀ (i : fin n₁),
                      vector.nth (s₁.threads) i =
                        {tlocal := (init ↑i) & "n" ::= m₁ 0, shared := m₁, loads := insert 0 ((vector.nth (s₁.threads) i).loads), stores := ∅}) ∧
                (∀ (i : fin n₂),
                    vector.nth (s₂.threads) i =
                        {tlocal := init ↑i, shared := m₂, loads := ∅, stores := ∅}) ∧
                    m₁ = m₂ ∧ ↥(all_threads_active ac₁) ∧ ↥(all_threads_active ac₂))),
    {
        intros n₁ n₂ s₁ s₁' s₂ ac₁ ac₂ hp hek₁,
        cases hp with m₁ hp,
        cases hp with m₂ hp,
        apply exists.intro s₂,
        apply and.intro,
        {
            suffices h : exec_state (compute id) ac₂ s₂ (state.map_active_threads ac₂ (thread_state.map id) s₂),
            {
                rw ← state.map_active_threads_id s₂ ac₂ at h,
                assumption,
            },
            apply exec_state.compute,
        }, {
            simp,
            apply exists.intro m₁,
            cases hek₁,
            apply and.intro,
            {

                sorry -- memory does not change
            }, {
                apply exists.intro m₂,
                apply and.intro,
                { apply hp.right.left, },
                {
                    apply and.intro hp.right.right.left (and.intro hp.right.right.right.left (and.intro _ hp.right.right.right.right.right)),
                    intro i,
                    -- rw ← hp.right.right.right.right.left,
                    simp,
                    have haa: ↥(vector.nth ac₁ i) := begin
                        apply all_threads_active_nth,
                        exact hp.right.right.right.right.right.right.right.left,
                    end,
                    simp [haa],
                    rw thread_state.load,
                    rw thread_state.load._match_1,
                    have : m₁ = (vector.nth (s₁.threads) i).shared := begin
                        rw hp.right.right.right.right.left,
                    end,
                    subst this,
                    simp,
                    have : (vector.nth (s₁.threads) i).tlocal = (init i) := begin
                        rw hp.right.right.right.right.left,
                    end,
                    rw this,
                    rw memory.get,
                    simp,
                    rw hp.right.right.right.right.left,
                }
            }
        }
    }, {

    }
end

end arrcp -/


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
import data.option.basic

/-!
# Disjoint union of types

This file proves basic results about the sum type `α ⊕ β`.

`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.

## Main declarations

* `sum.get_left`: Retrieves the left content of `x : α ⊕ β` or returns `none` if it's coming from
  the right.
* `sum.get_right`: Retrieves the right content of `x : α ⊕ β` or returns `none` if it's coming from
  the left.
* `sum.is_left`: Returns whether `x : α ⊕ β` comes from the left component or not.
* `sum.is_right`: Returns whether `x : α ⊕ β` comes from the right component or not.
* `sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise.
* `sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`.
* `sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components.
* `sum.lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`.

## Notes

The definition of `sum` takes values in `Type*`. This effectively forbids `Prop`- valued sum types.
To this effect, we have `psum`, which takes value in `Sort*` and carries a more complicated
universe signature in consequence. The `Prop` version is `or`.
-/

universes u v w x
variables {α : Type u} {α' : Type w} {β : Type v} {β' : Type x} {γ δ : Type*}

namespace sum

attribute [derive decidable_eq] sum

@[simp] lemma «forall» {p : α ⊕ β → Prop} : (∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) :=
⟨λ h, ⟨λ a, h _, λ b, h _⟩, λ ⟨h₁, h₂⟩, sum.rec h₁ h₂⟩

@[simp] lemma «exists» {p : α ⊕ β → Prop} : (∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) :=
⟨λ h, match h with
| ⟨inl a, h⟩ := or.inl ⟨a, h⟩
| ⟨inr b, h⟩ := or.inr ⟨b, h⟩
end, λ h, match h with
| or.inl ⟨a, h⟩ := ⟨inl a, h⟩
| or.inr ⟨b, h⟩ := ⟨inr b, h⟩
end⟩

lemma inl_injective : function.injective (inl : α → α ⊕ β) := λ x y, inl.inj
lemma inr_injective : function.injective (inr : β → α ⊕ β) := λ x y, inr.inj

section get

/-- Check if a sum is `inl` and if so, retrieve its contents. -/
@[simp] def get_left : α ⊕ β → option α
| (inl a) := some a
| (inr _) := none

/-- Check if a sum is `inr` and if so, retrieve its contents. -/
@[simp] def get_right : α ⊕ β → option β
| (inr b) := some b
| (inl _) := none

/-- Check if a sum is `inl`. -/
@[simp] def is_left : α ⊕ β → bool
| (inl _) := tt
| (inr _) := ff

/-- Check if a sum is `inr`. -/
@[simp] def is_right : α ⊕ β → bool
| (inl _) := ff
| (inr _) := tt

variables {x y : α ⊕ β}

lemma get_left_eq_none_iff : x.get_left = none ↔ x.is_right :=
by cases x; simp only [get_left, is_right, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

lemma get_right_eq_none_iff : x.get_right = none ↔ x.is_left :=
by cases x; simp only [get_right, is_left, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

end get

/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
protected def map (f : α → α') (g : β → β')  : α ⊕ β → α' ⊕ β'
| (inl x) := inl (f x)
| (inr x) := inr (g x)

@[simp] lemma map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
@[simp] lemma map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl

@[simp] lemma map_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  ∀ x : α ⊕ β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
| (inl a) := rfl
| (inr b) := rfl

@[simp] lemma map_comp_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  (sum.map f' g') ∘ (sum.map f g) = sum.map (f' ∘ f) (g' ∘ g) :=
funext $ map_map f' g' f g

@[simp] lemma map_id_id (α β) : sum.map (@id α) (@id β) = id :=
funext $ λ x, sum.rec_on x (λ _, rfl) (λ _, rfl)

theorem inl.inj_iff {a b} : (inl a : α ⊕ β) = inl b ↔ a = b :=
⟨inl.inj, congr_arg _⟩

theorem inr.inj_iff {a b} : (inr a : α ⊕ β) = inr b ↔ a = b :=
⟨inr.inj, congr_arg _⟩

theorem inl_ne_inr {a : α} {b : β} : inl a ≠ inr b.

theorem inr_ne_inl {a : α} {b : β} : inr b ≠ inl a.

/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/
protected def elim {α β γ : Sort*} (f : α → γ) (g : β → γ) : α ⊕ β → γ := λ x, sum.rec_on x f g

@[simp] lemma elim_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : α) :
  sum.elim f g (inl x) = f x := rfl

@[simp] lemma elim_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : β) :
  sum.elim f g (inr x) = g x := rfl

@[simp] lemma elim_comp_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inl = f := rfl

@[simp] lemma elim_comp_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inr = g := rfl

@[simp] lemma elim_inl_inr {α β : Sort*} :
  @sum.elim α β _ inl inr = id :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

lemma comp_elim {α β γ δ : Sort*} (f : γ → δ) (g : α → γ) (h : β → γ):
  f ∘ sum.elim g h = sum.elim (f ∘ g) (f ∘ h) :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

@[simp] lemma elim_comp_inl_inr {α β γ : Sort*} (f : α ⊕ β → γ) :
  sum.elim (f ∘ inl) (f ∘ inr) = f :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

open function (update update_eq_iff update_comp_eq_of_injective update_comp_eq_of_forall_ne)

@[simp] lemma update_elim_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : α} {x : γ} :
  update (sum.elim f g) (inl i) x = sum.elim (update f i x) g :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_elim_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : β} {x : γ} :
  update (sum.elim f g) (inr i) x = sum.elim f (update g i x) :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_inl_comp_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α}
  {x : γ} :
  update f (inl i) x ∘ inl = update (f ∘ inl) i x :=
update_comp_eq_of_injective _ inl_injective _ _

@[simp] lemma update_inl_apply_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : α} {x : γ} :
  update f (inl i) x (inl j) = update (f ∘ inl) i x j :=
by rw ← update_inl_comp_inl

@[simp] lemma update_inl_comp_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {x : γ} :
  update f (inl i) x ∘ inr = f ∘ inr :=
update_comp_eq_of_forall_ne _ _ $ λ _, inr_ne_inl

@[simp] lemma update_inl_apply_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {j : β} {x : γ} :
  update f (inl i) x (inr j) = f (inr j) :=
function.update_noteq inr_ne_inl _ _

@[simp] lemma update_inr_comp_inl [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β} {x : γ} :
  update f (inr i) x ∘ inl = f ∘ inl :=
update_comp_eq_of_forall_ne _ _ $ λ _, inl_ne_inr

@[simp]

@[simp] lemma update_inr_comp_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β}
  {x : γ} :
  update f (inr i) x ∘ inr = update (f ∘ inr) i x :=
update_comp_eq_of_injective _ inr_injective _ _

@[simp] lemma update_inr_apply_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : β} {x : γ} :
  update f (inr i) x (inr j) = update (f ∘ inr) i x j :=
by rw ← update_inr_comp_inr

/-- Swap the factors of a sum type -/
@[simp] def swap : α ⊕ β → β ⊕ α
| (inl a) := inr a
| (inr b) := inl b

@[simp] lemma swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x; refl
@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext $ swap_swap
@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := swap_swap
@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := swap_swap

section lift_rel

/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between
`α ⊕ β` and `γ ⊕ δ`. -/
inductive lift_rel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop
| inl {a c} : r a c → lift_rel (inl a) (inl c)
| inr {b d} : s b d → lift_rel (inr b) (inr d)

attribute [protected] lift_rel.inl lift_rel.inr

variables {r r₁ r₂ : α → γ → Prop} {s s₁ s₂ : β → δ → Prop} {a : α} {b : β} {c : γ} {d : δ}
  {x : α ⊕ β} {y : γ ⊕ δ}

@[simp] lemma lift_rel_inl_inl : lift_rel r s (inl a) (inl c) ↔ r a c :=
⟨λ h, by { cases h, assumption }, lift_rel.inl⟩

@[simp] lemma not_lift_rel_inl_inr : ¬ lift_rel r s (inl a) (inr d) .
@[simp] lemma not_lift_rel_inr_inl : ¬ lift_rel r s (inr b) (inl c) .

@[simp] lemma lift_rel_inr_inr : lift_rel r s (inr b) (inr d) ↔ s b d :=
⟨λ h, by { cases h, assumption }, lift_rel.inr⟩

instance [Π a c, decidable (r a c)] [Π b d, decidable (s b d)] :
  Π (ab : α ⊕ β) (cd : γ ⊕ δ), decidable (lift_rel r s ab cd)
| (inl a) (inl c) := decidable_of_iff' _ lift_rel_inl_inl
| (inl a) (inr d) := decidable.is_false not_lift_rel_inl_inr
| (inr b) (inl c) := decidable.is_false not_lift_rel_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lift_rel_inr_inr

lemma lift_rel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b)
  (h : lift_rel r₁ s₁ x y) :
  lift_rel r₂ s₂ x y :=
by { cases h, exacts [lift_rel.inl (hr _ _ ‹_›), lift_rel.inr (hs _ _ ‹_›)] }

lemma lift_rel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lift_rel r₁ s x y) :
  lift_rel r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lift_rel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lift_rel r s₁ x y) :
  lift_rel r s₂ x y :=
h.mono (λ _ _, id) hs

protected lemma lift_rel.swap (h : lift_rel r s x y) : lift_rel s r x.swap y.swap :=
by { cases h, exacts [lift_rel.inr ‹_›, lift_rel.inl ‹_›] }

@[simp] lemma lift_rel_swap_iff : lift_rel s r x.swap y.swap ↔ lift_rel r s x y :=
⟨λ h, by { rw [←swap_swap x, ←swap_swap y], exact h.swap }, lift_rel.swap⟩

end lift_rel

section lex

/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the
respective order on `α` or `β`. -/
inductive lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop
| inl {a₁ a₂} (h : r a₁ a₂) : lex (inl a₁) (inl a₂)
| inr {b₁ b₂} (h : s b₁ b₂) : lex (inr b₁) (inr b₂)
| sep (a b) : lex (inl a) (inr b)

attribute [protected] sum.lex.inl sum.lex.inr
attribute [simp] lex.sep

variables {r r₁ r₂ : α → α → Prop} {s s₁ s₂ : β → β → Prop} {a a₁ a₂ : α} {b b₁ b₂ : β}
  {x y : α ⊕ β}

@[simp] lemma lex_inl_inl : lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
⟨λ h, by { cases h, assumption }, lex.inl⟩

@[simp] lemma lex_inr_inr : lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
⟨λ h, by { cases h, assumption }, lex.inr⟩

@[simp] lemma lex_inr_inl : ¬ lex r s (inr b) (inl a) .

instance [decidable_rel r] [decidable_rel s] : decidable_rel (lex r s)
| (inl a) (inl c) := decidable_of_iff' _ lex_inl_inl
| (inl a) (inr d) := decidable.is_true (lex.sep _ _)
| (inr b) (inl c) := decidable.is_false lex_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lex_inr_inr

protected lemma lift_rel.lex {a b : α ⊕ β} (h : lift_rel r s a b) : lex r s a b :=
by { cases h, exacts [lex.inl ‹_›, lex.inr ‹_›] }

lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r₁ s₁ x y) :
  lex r₂ s₂ x y :=
by { cases h, exacts [lex.inl (hr _ _ ‹_›), lex.inr (hs _ _ ‹_›), lex.sep _ _] }

lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lex r₁ s x y) : lex r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lex r s₁ x y) : lex r s₂ x y :=
h.mono (λ _ _, id) hs

lemma lex_acc_inl {a} (aca : acc r a) : acc (lex r s) (inl a) :=
begin
  induction aca with a H IH,
  constructor, intros y h,
  cases h with a' _ h',
  exact IH _ h'
end

lemma lex_acc_inr (aca : ∀ a, acc (lex r s) (inl a)) {b} (acb : acc s b) : acc (lex r s) (inr b) :=
begin
  induction acb with b H IH,
  constructor, intros y h,
  cases h with _ _ _ b' _ h' a,
  { exact IH _ h' },
  { exact aca _ }
end

lemma lex_wf (ha : well_founded r) (hb : well_founded s) : well_founded (lex r s) :=
have aca : ∀ a, acc (lex r s) (inl a), from λ a, lex_acc_inl (ha.apply a),
⟨λ x, sum.rec_on x aca (λ b, lex_acc_inr aca (hb.apply b))⟩

end lex
end sum

namespace function

open sum

lemma injective.sum_elim {f : α → γ} {g : β → γ}
  (hf : injective f) (hg : injective g) (hfg : ∀ a b, f a ≠ g b) :
  injective (sum.elim f g)
| (inl x) (inl y) h := congr_arg inl $ hf h
| (inl x) (inr y) h := (hfg x y h).elim
| (inr x) (inl y) h := (hfg y x h.symm).elim
| (inr x) (inr y) h := congr_arg inr $ hg h

lemma injective.sum_map {f : α → β} {g : α' → β'} (hf : injective f) (hg : injective g) :
  injective (sum.map f g)
| (inl x) (inl y) h := congr_arg inl $ hf $ inl.inj h
| (inr x) (inr y) h := congr_arg inr $ hg $ inr.inj h

lemma surjective.sum_map {f : α → β} {g : α' → β'} (hf : surjective f) (hg : surjective g) :
  surjective (sum.map f g)
| (inl y) := let ⟨x, hx⟩ := hf y in ⟨inl x, congr_arg inl hx⟩
| (inr y) := let ⟨x, hx⟩ := hg y in ⟨inr x, congr_arg inr hx⟩

end function


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.indicator_function
import Mathlib.order.filter.at_top_bot
import Mathlib.PostPort

universes u_1 u_3 u_2

namespace Mathlib

/-!
# Indicator function and filters

Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.

## Tags
indicator, characteristic, filter
-/

theorem indicator_eventually_eq {α : Type u_1} {M : Type u_3} [HasZero M] {s : set α} {t : set α}
    {f : α → M} {g : α → M} {l : filter α} (hf : filter.eventually_eq (l ⊓ filter.principal s) f g)
    (hs : filter.eventually_eq l s t) :
    filter.eventually_eq l (set.indicator s f) (set.indicator t g) :=
  sorry

theorem indicator_union_eventually_eq {α : Type u_1} {M : Type u_3} [add_monoid M] {s : set α}
    {t : set α} {f : α → M} {l : filter α} (h : filter.eventually (fun (a : α) => ¬a ∈ s ∩ t) l) :
    filter.eventually_eq l (set.indicator (s ∪ t) f) (set.indicator s f + set.indicator t f) :=
  filter.eventually.mono h
    fun (a : α) (ha : ¬a ∈ s ∩ t) => set.indicator_union_of_not_mem_inter ha f

theorem indicator_eventually_le_indicator {α : Type u_1} {β : Type u_2} [HasZero β] [preorder β]
    {s : set α} {f : α → β} {g : α → β} {l : filter α}
    (h : filter.eventually_le (l ⊓ filter.principal s) f g) :
    filter.eventually_le l (set.indicator s f) (set.indicator s g) :=
  filter.eventually.mono (iff.mp filter.eventually_inf_principal h)
    fun (a : α) (h : a ∈ s → f a ≤ g a) => set.indicator_rel_indicator (le_refl 0) h

theorem tendsto_indicator_of_monotone {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι]
    [HasZero β] (s : ι → set α) (hs : monotone s) (f : α → β) (a : α) :
    filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
        (pure (set.indicator (set.Union fun (i : ι) => s i) f a)) :=
  sorry

theorem tendsto_indicator_of_antimono {α : Type u_1} {β : Type u_2} {ι : Type u_3} [preorder ι]
    [HasZero β] (s : ι → set α) (hs : ∀ {i j : ι}, i ≤ j → s j ⊆ s i) (f : α → β) (a : α) :
    filter.tendsto (fun (i : ι) => set.indicator (s i) f a) filter.at_top
        (pure (set.indicator (set.Inter fun (i : ι) => s i) f a)) :=
  sorry

theorem tendsto_indicator_bUnion_finset {α : Type u_1} {β : Type u_2} {ι : Type u_3} [HasZero β]
    (s : ι → set α) (f : α → β) (a : α) :
    filter.tendsto
        (fun (n : finset ι) =>
          set.indicator (set.Union fun (i : ι) => set.Union fun (H : i ∈ n) => s i) f a)
        filter.at_top (pure (set.indicator (set.Union s) f a)) :=
  sorry

end Mathlib


/-
  Specifications file for signature_spec.cairo

  Do not modify the constant definitions, structure definitions, or automatic specifications.
  Do not change the name or arguments of the user specifications and soundness theorems.

  You may freely move the definitions around in the file.
  You may add definitions and theorems wherever you wish in this file.
-/
import starkware.cairo.lean.semantics.soundness.prelude
import starkware.cairo.common.cairo_secp.ec_spec
import starkware.cairo.common.cairo_secp.bigint_spec
import starkware.cairo.common.cairo_secp.constants_spec
import starkware.cairo.common.cairo_secp.field_spec
import starkware.cairo.common.math_spec

open starkware.cairo.common.cairo_secp.ec
open starkware.cairo.common.cairo_secp.bigint
open starkware.cairo.common.cairo_secp.constants
open starkware.cairo.common.cairo_secp.field
open starkware.cairo.common.math

namespace starkware.cairo.common.cairo_secp.signature

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]

--variables {secpF : Type} [secp_field secpF]

-- End of automatically generated prelude.

/-
-- Function: get_generator_point
-/

/- get_generator_point autogenerated specification -/

def gen_point (F : Type) [field F] : EcPoint F :=
  ⟨⟨17117865558768631194064792,
    12501176021340589225372855,
    9198697782662356105779718⟩,
   ⟨6441780312434748884571320,
     57953919405111227542741658,
     5457536640262350763842127⟩⟩

def gen_point_data (F : Type) [field F] [decidable_eq F] [prelude_hyps F]
    (secpF : Type) [secp_field secpF]:
  BddECPointData secpF (gen_point F) :=
{ ix := ⟨17117865558768631194064792,
         12501176021340589225372855,
         9198697782662356105779718⟩,
  iy := ⟨6441780312434748884571320,
         57953919405111227542741658,
         5457536640262350763842127⟩,
  ixbdd := begin
             rw [bigint3.bounded, BASE], simp_int_casts,
             repeat { rw [abs_of_nonneg] },
             repeat { norm_num }
            end,
  iybdd := begin
             rw [bigint3.bounded, BASE], simp_int_casts,
             repeat { rw [abs_of_nonneg] },
             repeat { norm_num }
            end,
  ptxeq := by { rw [gen_point, bigint3.toBigInt3], simp_int_casts, exact ⟨rfl, rfl, rfl⟩ },
  ptyeq := by { rw [gen_point, bigint3.toBigInt3], simp_int_casts, exact ⟨rfl, rfl, rfl⟩ },
  onEC :=
    begin
      right,
      rw [←int.cast_pow, ←int.cast_pow, (show (7 : secpF) = (7 : int), by simp_int_casts),
        ←int.cast_add, char_p.int_coe_eq_int_coe_iff secpF SECP_PRIME, bigint3.val, bigint3.val,
        SECP_PRIME_eq, int.modeq, BASE, SECP_REM],
      dsimp, simp_int_casts, norm_num,
    end }

-- Do not change this definition.
def auto_spec_get_generator_point (mem : F → F) (κ : ℕ) (ρ_point : EcPoint F) : Prop :=
  7 ≤ κ ∧
  ρ_point = {
    x := { d0 := 17117865558768631194064792, d1 := 12501176021340589225372855, d2 := 9198697782662356105779718 },
    y := { d0 := 6441780312434748884571320, d1 := 57953919405111227542741658, d2 := 5457536640262350763842127 }
  }

-- You may change anything in this definition except the name and arguments.
def spec_get_generator_point (mem : F → F) (κ : ℕ) (ρ_point : EcPoint F) : Prop :=
  ρ_point = gen_point F

/- get_generator_point soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_get_generator_point
    {mem : F → F}
    (κ : ℕ)
    (ρ_point : EcPoint F)
    (h_auto : auto_spec_get_generator_point mem κ ρ_point) :
  spec_get_generator_point mem κ ρ_point :=
begin
  exact h_auto.2
end

-- Function: div_mod_n

/- div_mod_n autogenerated specification -/

-- Do not change this definition.
def auto_spec_div_mod_n (mem : F → F) (κ : ℕ) (range_check_ptr : F) (a b : BigInt3 F) (ρ_range_check_ptr : F) (ρ_res : BigInt3 F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F) (res : BigInt3 F), spec_nondet_bigint3 mem κ₁ range_check_ptr range_check_ptr₁ res ∧
  ∃ (κ₂ : ℕ) (range_check_ptr₂ : F) (k : BigInt3 F), spec_nondet_bigint3 mem κ₂ range_check_ptr₁ range_check_ptr₂ k ∧
  ∃ (κ₃ : ℕ) (res_b : UnreducedBigInt5 F), spec_bigint_mul mem κ₃ res b res_b ∧
  ∃ n : BigInt3 F, n = {
    d0 := N0,
    d1 := N1,
    d2 := N2
  } ∧
  ∃ (κ₄ : ℕ) (k_n : UnreducedBigInt5 F), spec_bigint_mul mem κ₄ k n k_n ∧
  ∃ carry1 : F, carry1 = (res_b.d0 - k_n.d0 - a.d0) / (BASE : ℤ) ∧
  mem (range_check_ptr₂ + 0) = carry1 + 2 ^ 127 ∧
  is_range_checked (rc_bound F) (carry1 + 2 ^ 127) ∧
  ∃ carry2 : F, carry2 = (res_b.d1 - k_n.d1 - a.d1 + carry1) / (BASE : ℤ) ∧
  mem (range_check_ptr₂ + 1) = carry2 + 2 ^ 127 ∧
  is_range_checked (rc_bound F) (carry2 + 2 ^ 127) ∧
  ∃ carry3 : F, carry3 = (res_b.d2 - k_n.d2 - a.d2 + carry2) / (BASE : ℤ) ∧
  mem (range_check_ptr₂ + 2) = carry3 + 2 ^ 127 ∧
  is_range_checked (rc_bound F) (carry3 + 2 ^ 127) ∧
  ∃ carry4 : F, carry4 = (res_b.d3 - k_n.d3 + carry3) / (BASE : ℤ) ∧
  mem (range_check_ptr₂ + 3) = carry4 + 2 ^ 127 ∧
  is_range_checked (rc_bound F) (carry4 + 2 ^ 127) ∧
  res_b.d4 - k_n.d4 + carry4 = 0 ∧
  ∃ range_check_ptr₃ : F, range_check_ptr₃ = range_check_ptr₂ + 4 ∧
  κ₁ + κ₂ + κ₃ + κ₄ + 48 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₃ ∧
  ρ_res = res

-- You may change anything in this definition except the name and arguments.
def spec_div_mod_n (mem : F → F) (κ : ℕ) (range_check_ptr : F) (a b : BigInt3 F) (ρ_range_check_ptr : F) (ρ_res : BigInt3 F) : Prop :=
  ∀ ia : bigint3,
    ia.bounded (3 * BASE - 1) →
    a = ia.toBigInt3 →
  ∀ ib : bigint3,
    ib.bounded (3 * BASE - 1) →
    b = ib.toBigInt3 →
  ∃ ires : bigint3,
    ires.bounded (3 * BASE - 1) ∧
    ρ_res = ires.toBigInt3 ∧
    ires.val * ib.val ≡ ia.val [ZMOD secp_n]

/- div_mod_n soundness theorem -/

def iN0 : ℤ := N0
def iN1 : ℤ := N1
def iN2 : ℤ := N2

def secp_in : bigint3 := ⟨iN0, iN1, iN2⟩

def nBASE := BASE

--theorem secp_in_toBigInt3 : secp_in.toBigInt3 = secp_n := rfl

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_div_mod_n
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr : F) (a b : BigInt3 F) (ρ_range_check_ptr : F) (ρ_res : BigInt3 F)
    (h_auto : auto_spec_div_mod_n mem κ range_check_ptr a b ρ_range_check_ptr ρ_res) :
  spec_div_mod_n mem κ range_check_ptr a b ρ_range_check_ptr ρ_res :=
begin
  intros ia iabdd aeq ib ibbdd beq,
  rcases h_auto with ⟨_, _, res, hres, _, _, k, hk, _, res_b, hres_b, n, neq, _, k_n, hk_n,
    carry1, carry1eq, _, hcarry1,
    carry2, carry2eq, _, hcarry2,
    carry3, carry3eq, _, hcarry3,
    carry4, carry4eq, _, hcarry4,
    diff_eq, _, _, _, _, ρ_res_eq⟩,
  rcases nondet_bigint3_corr hres with ⟨ires, reseq, ires_bdd⟩,
  rcases nondet_bigint3_corr hk with ⟨ik, keq, ik_bdd⟩,
  change _ = _ at hres_b,
  change _ = _ at hk_n,
  rcases rc_to_int hcarry1 with ⟨icarry1, carry1eq', carry1_bdd⟩,
  rcases rc_to_int hcarry2 with ⟨icarry2, carry2eq', carry2_bdd⟩,
  rcases rc_to_int hcarry3 with ⟨icarry3, carry3eq', carry3_bdd⟩,
  rcases rc_to_int hcarry4 with ⟨icarry4, carry4eq', carry4_bdd⟩,
  have BASEnonneg : 0 ≤ (BASE : ℤ) := int.coe_zero_le BASE,
  have iN0nonneg : 0 ≤ iN0 := int.coe_zero_le _,
  have iN1nonneg : 0 ≤ iN1 := int.coe_zero_le _,
  have iN2nonneg : 0 ≤ iN2 := int.coe_zero_le _,
  have absBASEeq : abs (BASE : ℤ) = BASE := abs_of_nonneg BASEnonneg,
  have BASEnz : ((BASE : ℤ) : F) ≠ 0,
  { suffices : ((2 : ℤ) : F) ≠ 0,
      by simpa using this,
    haveI : char_p F PRIME := prelude_hyps.charF,
    rw [ne, char_p.int_cast_eq_zero_iff F PRIME, PRIME],
    simp_int_casts, norm_num },
  have aux3 : ∀ {x y : F}, x = y / (BASE : ℤ) → x * 2 ^ 86 = y,
  { intros x y xeq,
    rw [eq_div_iff BASEnz, int.cast_coe_nat, BASE] at xeq,
    simp only [nat.cast_bit0, nat.cast_one, nat.cast_pow] at xeq,
    exact xeq },
  have secp_in_toBigInt3 : secp_in.toBigInt3 = n,
  { rw [neq, bigint3.toBigInt3, secp_in], dsimp,
    rw [iN0, iN1, iN2, int.cast_coe_nat, int.cast_coe_nat, int.cast_coe_nat] },
  have : (((((ires.bigint5_mul ib).sub (ik.bigint5_mul secp_in)).sub ia.to_bigint5).add
          ⟨0, icarry1, icarry2, icarry3, 0⟩).toUnreducedBigInt5 : UnreducedBigInt5 F) =
      bigint5.toUnreducedBigInt5
        (⟨icarry1*BASE, icarry2*BASE, icarry3*BASE, icarry4*BASE, -icarry4⟩),
  { rw [bigint5.toUnreducedBigInt5_add, bigint5.toUnreducedBigInt5_sub,
        bigint5.toUnreducedBigInt5_sub, bigint3.bigint5_mul_toUnreducedBigInt5,
        bigint3.bigint5_mul_toUnreducedBigInt5],
    conv { to_rhs, rw [bigint5.toUnreducedBigInt5], simp },
    rw [←carry1eq', aux3 carry1eq, ←carry2eq', aux3 carry2eq, ←carry3eq', aux3 carry3eq,
      ←carry4eq', aux3 carry4eq, ←reseq, ←keq, ←beq, ←hres_b, secp_in_toBigInt3, ←hk_n,
      bigint3.to_bigint5_to_Unreduced_BigInt5, ←aeq],
    simp [UnreducedBigInt5.sub, UnreducedBigInt5.add,
      starkware.cairo.common.cairo_secp.bigint.bigint3.to_bigint5, bigint5.toUnreducedBigInt5,
        BigInt3.toUnreducedBigInt5],
    simp [carry1eq', carry2eq', carry3eq', eq_sub_of_add_eq diff_eq] },
  have eq :  ((((ires.bigint5_mul ib).sub (ik.bigint5_mul secp_in)).sub ia.to_bigint5).add
          ⟨0, icarry1, icarry2, icarry3, 0⟩) =
        ⟨icarry1*BASE, icarry2*BASE, icarry3*BASE, icarry4*BASE, -icarry4⟩,
  { apply bigint5.toUnreducedBigInt5_eq_of_sub_bounded this,
    have : (2^127 : ℤ) * BASE + (3 * (3 * BASE - 1)^2 +
      (3 * (3 * (BASE - 1))^2) + (3 * BASE - 1) + 2^127) ≤ PRIME - 1,
    { rw [PRIME, BASE], simp_int_casts, norm_num },
    apply bigint5.bounded_of_bounded_of_le _ this,
    apply bigint5.bounded_sub,
    { simp [bigint5.bounded, abs_mul, absBASEeq],
      use [carry1_bdd, carry2_bdd, carry3_bdd, carry4_bdd],
      apply le_trans carry4_bdd, norm_num },
    apply bigint5.bounded_add, swap,
    { simp [bigint5.bounded],
      use [carry1_bdd, carry2_bdd, carry3_bdd] },
    apply bigint5.bounded_sub _ (bigint3.to_bigint5_bounded iabdd),
    apply bigint5.bounded_sub,
    apply bigint3.bounded_bigint5_mul (bigint3.bounded_of_bounded_of_le ires_bdd bound_slack) ibbdd,
    apply bigint3.bounded_bigint5_mul ik_bdd,
    rw [secp_in, bigint3.bounded], dsimp,
    simp [abs_of_nonneg iN0nonneg, abs_of_nonneg iN1nonneg, abs_of_nonneg iN2nonneg],
    simp [iN0, iN1, iN2],
    norm_num,  },
  have : ires.val * ib.val = ik.val * secp_n + ia.val,
  { simp only [bigint3.val, secp_n, int.cast_add, int.coe_nat_add, int.coe_nat_mul],
    rw [int.coe_nat_pow BASE 2],
    set iBASE := (BASE : ℤ),
    simp only [bigint3.bigint5_mul, bigint5.add, bigint5.sub, bigint3.to_bigint5, secp_in, add_zero, sub_zero] at eq,
    rcases eq with ⟨eq1, eq2, eq3, eq4, eq5⟩,
    rw [←iN0, ←iN1, ←iN2],
    transitivity (ires.i2 * ib.i2 * iBASE * iBASE * iBASE * iBASE) +
      (ires.i2 * iBASE ^ 2 * (ib.i1 * iBASE + ib.i0)) +
      (ires.i1 * iBASE + ires.i0) * (ib.i2 * iBASE ^ 2 + ib.i1 * iBASE + ib.i0),
    rw [pow_two], ring,
    rw [eq_add_of_sub_eq eq5, add_mul, add_mul, add_mul],
    rw [←neg_mul_eq_neg_mul, ←eq4, neg_add],
    simp only [add_mul _ _ iBASE],
    rw [←neg_mul_eq_neg_mul icarry3, ←eq3, neg_add],
    simp only [add_mul _ _ iBASE],
    rw [←neg_mul_eq_neg_mul icarry2, ←eq2, neg_add],
    simp only [add_mul _ _ iBASE],
    rw [←neg_mul_eq_neg_mul icarry1, ←eq1],
    ring },
  use ires,
  split, apply bigint3.bounded_of_bounded_of_le ires_bdd bound_slack,
  use ρ_res_eq.trans reseq,
  rw [this, int.modeq, add_comm, int.add_mul_mod_self]
end

/-
-- Function: get_point_from_x
-/

/- get_point_from_x autogenerated specification -/

-- Do not change this definition.
def auto_spec_get_point_from_x (mem : F → F) (κ : ℕ) (range_check_ptr : F) (x : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_point : EcPoint F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_nn mem κ₁ range_check_ptr v range_check_ptr₁ ∧
  ∃ (κ₂ : ℕ) (x_square : UnreducedBigInt3 F), spec_unreduced_sqr mem κ₂ x x_square ∧
  ∃ (κ₃ : ℕ) (range_check_ptr₂ : F) (x_square_reduced : BigInt3 F), spec_reduce mem κ₃ range_check_ptr₁ x_square range_check_ptr₂ x_square_reduced ∧
  ∃ (κ₄ : ℕ) (x_cube : UnreducedBigInt3 F), spec_unreduced_mul mem κ₄ x x_square_reduced x_cube ∧
  ∃ (κ₅ : ℕ) (range_check_ptr₃ : F) (y : BigInt3 F), spec_nondet_bigint3 mem κ₅ range_check_ptr₂ range_check_ptr₃ y ∧
  ∃ (κ₆ : ℕ) (range_check_ptr₄ : F), spec_validate_reduced_field_element mem κ₆ range_check_ptr₃ y range_check_ptr₄ ∧
  ∃ (κ₇ : ℕ) (range_check_ptr₅ : F), spec_assert_nn mem κ₇ range_check_ptr₄ ((y.d0 + v) / (2 : ℤ)) range_check_ptr₅ ∧
  ∃ (κ₈ : ℕ) (y_square : UnreducedBigInt3 F), spec_unreduced_sqr mem κ₈ y y_square ∧
  ∃ (κ₉ : ℕ) (range_check_ptr₆ : F), spec_verify_zero mem κ₉ range_check_ptr₅ {
    d0 := x_cube.d0 + BETA - y_square.d0,
    d1 := x_cube.d1 - y_square.d1,
    d2 := x_cube.d2 - y_square.d2
  } range_check_ptr₆ ∧
  κ₁ + κ₂ + κ₃ + κ₄ + κ₅ + κ₆ + κ₇ + κ₈ + κ₉ + 54 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₆ ∧
  ρ_point = {
    x := x,
    y := y
  }

theorem aux {a b c : ℕ} (h : a + b = 2 * c) : a % 2 = b % 2 :=
begin
  have : a + 2 * b = 2 * c + b,
  { nth_rewrite 0 (two_mul b),
    rw [←add_assoc, h] },
  have h' := congr_arg (λ n : ℕ, n % 2) this,
  dsimp at h',
  rw [nat.add_mul_mod_self_left, add_comm, nat.add_mul_mod_self_left] at h',
  exact h'
end

-- You may change anything in this definition except the name and arguments.
def spec_get_point_from_x (mem : F → F) (κ : ℕ) (range_check_ptr : F) (x : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_point : EcPoint F) : Prop :=
   ∀ (secpF : Type) [hsecp : secp_field secpF],
   by exactI
      x ≠ ⟨0, 0, 0⟩ →
      ∀ ix : bigint3,
        ix.bounded (3 * BASE - 1) →
        x = ix.toBigInt3 →
        ∃ nv : ℕ,
          nv < rc_bound F ∧
          v = ↑nv ∧
        ∃ iyval : ℕ,
          iyval < SECP_PRIME ∧
          nv % 2 = iyval % 2 ∧
        ∃ h : @on_ec secpF _ (ix.val, iyval),
        ∃ hres : BddECPointData secpF ρ_point,
          hres.toECPoint = ECPoint.AffinePoint ⟨_, _, h⟩

/- get_point_from_x soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_get_point_from_x
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr : F) (x : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_point : EcPoint F)
    (h_auto : auto_spec_get_point_from_x mem κ range_check_ptr x v ρ_range_check_ptr ρ_point) :
  spec_get_point_from_x mem κ range_check_ptr x v ρ_range_check_ptr ρ_point :=
begin
  intros secpF _,
  resetI,
  intros xnez ix ixbdd xeq,
  rcases h_auto with
    ⟨_, _, h_nn_v,
    _, x_square, h_x_square,
    _, _, x_square_reduced, h_x_square_reduced,
    _, x_cube, h_x_cube,
    _, _, y, h_nondet_bigint3_y,
    _, _, h_validate_reduced_y,
    _, _, h_nn_y_v_div,
    _, y_square, h_unreduced_y_square,
    _, _, h_verify_zero,
    _, _, ρ_point_eq⟩,
  rcases h_nn_v with ⟨nv, nvlt, veq⟩,
  have x_square_eq := h_x_square ix xeq,
  have : ix.sqr.bounded (2 ^ 249),
  { apply bigint3.bounded_of_bounded_of_le
      (bigint3.bounded_sqr ixbdd),
    rw [BASE, SECP_REM], simp_int_casts, norm_num },
  rcases h_x_square_reduced ix.sqr this x_square_eq with
    ⟨ixsqr', ixsqr'bdd, hixsqr', x_square_reduced_eq⟩,
  have x_cube_eq := h_x_cube ix ixsqr' xeq x_square_reduced_eq,
  rcases nondet_bigint3_corr h_nondet_bigint3_y with ⟨iy, yeq, iybdd⟩,
  rcases h_validate_reduced_y with ⟨n0, n1, n2, n0le, n1le, n2le, yvallt, yeq'⟩,
  rcases h_nn_y_v_div with ⟨nydiv, nydivlt, ydiveq⟩,
  have : y.d0 + v = ↑(2 * nydiv),
  { rw [mul_comm, nat.cast_mul],
    symmetry, simp,
    rw [← (eq_div_iff (PRIME.two_ne_zero F)), ← ydiveq],
    simp },
  have : n0 + nv = 2 * nydiv,
  { rw [yeq', veq, ← nat.cast_add] at this,
    apply nat.cast_inj_of_lt_char _ _ this,
    apply lt_of_le_of_lt (add_le_add n0le (le_of_lt nvlt)),
    apply lt_of_le_of_lt (add_le_add_left (rc_bound_hyp F) _),
    rw [BASE, PRIME.char_eq, PRIME],
    norm_num,
    apply lt_of_le_of_lt,
    apply nat.mul_le_mul_left 2
      (le_trans (le_of_lt nydivlt) (rc_bound_hyp F)),
    rw [PRIME.char_eq, PRIME], norm_num },
  have n02eqmv2 : n0 % 2 = nv % 2 := aux this,
  let  iy' : bigint3 := ⟨n0, n1, n2⟩,
  have iy'bdd : iy'.bounded (3 * ↑BASE - 1),
  { suffices : iy'.bounded BASE,
    { apply bigint3.bounded_of_bounded_of_le this,
      rw BASE, simp_int_casts, norm_num },
    simp only [bigint3.bounded, int.coe_nat_abs, int.coe_nat_le],
    split, { apply le_trans n0le tsub_le_self },
    split, { apply le_trans n1le tsub_le_self },
    apply le_trans n2le,
    norm_num [P2, BASE] },
  have yeq'' : y = iy'.toBigInt3,
  { rw [yeq', bigint3.toBigInt3], dsimp [iy'],
    simp only [int.cast_coe_nat, eq_self_iff_true, and_self] },
  have y_square_eq := h_unreduced_y_square iy' yeq'',
  let idiff := ((ix.mul ixsqr').add ⟨7,0,0⟩).sub iy'.sqr,
  have hidiff1 : idiff.toUnreducedBigInt3 = ⟨x_cube.d0 + ↑BETA - y_square.d0, x_cube.d1 - y_square.d1, x_cube.d2 - y_square.d2⟩,
  { simp [idiff, BETA, bigint3.toUnreducedBigInt3_add, bigint3.toUnreducedBigInt3_sub, ←x_cube_eq, ←y_square_eq],
    simp [bigint3.toUnreducedBigInt3, UnreducedBigInt3.add, UnreducedBigInt3.sub] },
  have hidiff2 : idiff.bounded (2 ^ 250),
  { suffices : idiff.bounded ((3 * BASE - 1)^2 * (8 * SECP_REM + 1) + 7 +
      (3 * BASE - 1)^2 * (8 * SECP_REM + 1)),
    { apply bigint3.bounded_of_bounded_of_le this,
     rw [BASE, SECP_REM], simp_int_casts, norm_num },
    apply bigint3.bounded_sub,
    apply bigint3.bounded_add,
    apply bigint3.bounded_mul ixbdd (bigint3.bounded_of_bounded_of_le ixsqr'bdd bound_slack),
    { simp [bigint3.bounded], rw abs_of_nonneg; norm_num },
    apply bigint3.bounded_sqr iy'bdd },
  have := h_verify_zero idiff hidiff1.symm hidiff2,
  have h_on_ec : on_ec ((ix.val : secpF), iy'.val),
  { simp [on_ec],
    suffices : (↑(iy'.val ^ 2) : secpF) = ↑(ix.val ^ 3 + 7),
    { simpa using this },
    rw [char_p.int_coe_eq_int_coe_iff secpF SECP_PRIME, int.modeq],
    symmetry,
    rw [int.mod_eq_mod_iff_mod_sub_eq_zero, ←this],
    dsimp [idiff],
    rw [bigint3.sub_val, bigint3.add_val],
    apply int.modeq.sub,
    apply int.modeq.add,
    rw [pow_succ],
    apply int.modeq.symm,
    apply int.modeq.trans,
    apply bigint3.mul_val,
    apply int.modeq.mul_left,
    apply int.modeq.trans hixsqr',
    apply bigint3.sqr_val,
    { simp [bigint3.val] },
    apply int.modeq.symm,
    apply bigint3.sqr_val },
  have iy'valeq : (↑(n2 * BASE ^ 2 + n1 * BASE + n0) : secpF) = iy'.val,
  { dsimp [iy'], simp [bigint3.val] },
  use [nv, nvlt, veq, n2 * BASE ^ 2 + n1 * BASE + n0, yvallt],
  split,
  { rw [←n02eqmv2, nat.add_mod, nat.add_mod (n2 * _), nat.mul_mod, BASE],
    norm_num,
    rw [nat.add_mod, nat.mul_mod],
    norm_num },
  rw iy'valeq,
  use h_on_ec,
  rw ρ_point_eq,
  use ⟨ix, iy', ixbdd, iy'bdd, xeq, yeq'', or.inr h_on_ec⟩,
  simp [BddECPointData.toECPoint, dif_neg xnez]
end

/-
-- Function: recover_public_key
-/

/- recover_public_key autogenerated specification -/

-- Do not change this definition.
def auto_spec_recover_public_key (mem : F → F) (κ : ℕ) (range_check_ptr : F) (msg_hash r s : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_public_key_point : EcPoint F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F) (r_point : EcPoint F), spec_get_point_from_x mem κ₁ range_check_ptr r v range_check_ptr₁ r_point ∧
  ∃ (κ₂ : ℕ) (generator_point : EcPoint F), spec_get_generator_point mem κ₂  generator_point ∧
  ∃ (κ₃ : ℕ) (range_check_ptr₂ : F) (u1 : BigInt3 F), spec_div_mod_n mem κ₃ range_check_ptr₁ msg_hash r range_check_ptr₂ u1 ∧
  ∃ (κ₄ : ℕ) (range_check_ptr₃ : F) (u2 : BigInt3 F), spec_div_mod_n mem κ₄ range_check_ptr₂ s r range_check_ptr₃ u2 ∧
  ∃ (κ₅ : ℕ) (range_check_ptr₄ : F) (point1 : EcPoint F), spec_ec_mul mem κ₅ range_check_ptr₃ generator_point u1 range_check_ptr₄ point1 ∧
  ∃ (κ₆ : ℕ) (range_check_ptr₅ : F) (minus_point1 : EcPoint F), spec_ec_negate mem κ₆ range_check_ptr₄ point1 range_check_ptr₅ minus_point1 ∧
  ∃ (κ₇ : ℕ) (range_check_ptr₆ : F) (point2 : EcPoint F), spec_ec_mul mem κ₇ range_check_ptr₅ r_point u2 range_check_ptr₆ point2 ∧
  ∃ (κ₈ : ℕ) (range_check_ptr₇ : F) (public_key_point : EcPoint F), spec_ec_add mem κ₈ range_check_ptr₆ minus_point1 point2 range_check_ptr₇ public_key_point ∧
  κ₁ + κ₂ + κ₃ + κ₄ + κ₅ + κ₆ + κ₇ + κ₈ + 77 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₇ ∧
  ρ_public_key_point = public_key_point

-- You may change anything in this definition except the name and arguments.
def spec_recover_public_key (mem : F → F) (κ : ℕ) (range_check_ptr : F) (msg_hash r s : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_public_key_point : EcPoint F) : Prop :=
  ∀ (secpF : Type) [secp_field secpF], by exactI
  r ≠ ⟨0, 0, 0⟩ →
  ∀ ir : bigint3,
    ir.bounded (3 * BASE - 1) →
    r = ir.toBigInt3 →
  ∀ is : bigint3,
    is.bounded (3 * BASE - 1) →
    s = is.toBigInt3 →
  ∀ imsg : bigint3,
    imsg.bounded (3 * BASE - 1) →
    msg_hash = imsg.toBigInt3 →
  ∃ nv : ℕ,
    nv < rc_bound F ∧
    v = ↑nv ∧
  ∃ iu1 iu2 : ℤ,
    iu1 * ir.val ≡ imsg.val [ZMOD secp_n] ∧
    iu2 * ir.val ≡ is.val [ZMOD secp_n] ∧
  ∃ ny : ℕ,
    ny < SECP_PRIME ∧
    nv ≡ ny [MOD 2] ∧
  ∃ h_on_ec : @on_ec secpF _ (ir.val, ny),
  ∃ hpoint  : BddECPointData secpF ρ_public_key_point,
    hpoint.toECPoint =
      -(iu1 • (gen_point_data F secpF).toECPoint) +
        iu2 • ECPoint.AffinePoint ⟨ir.val, ny, h_on_ec⟩

/- recover_public_key soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_recover_public_key
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr : F) (msg_hash r s : BigInt3 F) (v ρ_range_check_ptr : F) (ρ_public_key_point : EcPoint F)
    (h_auto : auto_spec_recover_public_key mem κ range_check_ptr msg_hash r s v ρ_range_check_ptr ρ_public_key_point) :
  spec_recover_public_key mem κ range_check_ptr msg_hash r s v ρ_range_check_ptr ρ_public_key_point :=
begin
  intros secpF _ rnez ir irbdd req is isbdd iseq imsg imsgbdd msgeq,
  resetI,
  rcases h_auto with ⟨_, _, r_point, hr_point,
    _, generator, hgenerator,
    _, _, u1, hu1,
    _, _, u2, hu2,
    _, _, point1, hpoint1,
    _, _, minus_point1, hminus_point1,
    _, _, point2, hpoint2,
    _, _, public_key_point, hpublic_key_point,
    _, _, rfl⟩,
  rcases hr_point secpF rnez ir irbdd req with ⟨nv, nvlt, veq, iy, iybdd, iy2, hiy, hr_point', ireq⟩,
  rw spec_get_generator_point at hgenerator,
  subst hgenerator,
  rcases hu1 imsg imsgbdd msgeq ir irbdd req with ⟨iu1, iu1bdd, u1eq, hu1'⟩,
  rcases hu2 is isbdd iseq ir irbdd req with ⟨iu2, iu2bdd, u2eq, hu2'⟩,
  have : (gen_point F).x ≠ ⟨0, 0, 0⟩,
  { simp [gen_point],
    intros eq _ _,
    suffices : (17117865558768631194064792 : ℤ) = 0,
    { norm_num at this },
    haveI : char_p F PRIME := prelude_hyps.charF,
    apply int.cast_eq_zero_of_lt_char F PRIME,
    { simp_int_casts, exact eq },
    rw [abs_of_nonneg, PRIME],
    simp_int_casts, norm_num, norm_num },
  rcases hpoint1 secpF this (gen_point_data F secpF) with
    ⟨n10, n10lt, n10eq, n11, n11lt, n11eq, n12, n12lt, n12eq, hpoint1', hpoint1eq⟩,
  rcases spec_ec_negate'_of_spec_ec_negate hminus_point1 secpF hpoint1' with
    ⟨hminus_point1', hminus_point1_eq⟩,
  have : r_point.x ≠ ⟨0, 0, 0⟩,
  { intro hcontr,
    rw [BddECPointData.toECPoint, dif_pos hcontr] at ireq,
    contradiction },
  rcases hpoint2 secpF this hr_point' with
    ⟨n20, n20lt, n20eq, n21, n21lt, n21eq, n22, n22lt, n22eq, hpoint2', hpoint2eq⟩,
  rcases hpublic_key_point secpF hminus_point1' hpoint2' with ⟨hret, hreteq⟩,
  refine ⟨nv, nvlt, veq, _, _, hu1', hu2', iy, iybdd, iy2, hiy, hret, _⟩,
  rw [hreteq, hminus_point1_eq, hpoint1eq, hpoint2eq, ireq],
  have aux : ∀ {i : ℤ} {n : ℕ}, abs i ≤ 3 * BASE - 1 → n < 2^86 → (i : F) = (n : F) → i = n,
  { intros i n hi hn hin,
    have : (i : F) = ((n : ℤ) : F),
    { rw hin, simp },
    apply PRIME.int_coe_inj this,
    have : (2^86 : ℤ) + (3 * BASE - 1) < PRIME,
    { simp only [PRIME], simp_int_casts, norm_num },
    apply lt_of_le_of_lt _ this,
    apply le_trans,
    apply abs_sub,
    apply add_le_add _ hi,
    rw abs_of_nonneg (int.coe_zero_le _),
    apply le_of_lt,
    norm_cast, exact hn },
  simp [u1eq, u2eq, bigint3.toBigInt3] at n10eq n11eq n12eq n20eq n21eq n22eq,
  have : iu1.val = ↑(2 ^ 172 * n12 + 2 ^ 86 * n11 + n10),
  { rw [bigint3.val], simp,
    rw [aux iu1bdd.1 n10lt n10eq, aux iu1bdd.2.1 n11lt n11eq,
        aux iu1bdd.2.2 (lt_of_lt_of_le n12lt (by norm_num)) n12eq ],
        ring },
  rw [this, nsmul_eq_smul_cast ℤ],
  have : iu2.val = ↑(2 ^ 172 * n22 + 2 ^ 86 * n21 + n20),
  { rw [bigint3.val], simp,
    rw [aux iu2bdd.1 n20lt n20eq, aux iu2bdd.2.1 n21lt n21eq,
        aux iu2bdd.2.2 (lt_of_lt_of_le n22lt (by norm_num)) n22eq ],
        ring },
  rw [this, nsmul_eq_smul_cast ℤ]
end

end starkware.cairo.common.cairo_secp.signature


import topology.filter
import measure_theory.measure.null_measurable
import measure_theory.measurable_space
import measure_theory.measure.measure_space
import number_theory.well_approximable
import topology.algebra.order.liminf_limsup

open set filter (hiding map) function measurable_space topological_space (second_countable_topology)
open_locale classical big_operators filter ennreal nnreal interval measure_theory

namespace measure_theory

variables {α : Type*} {m : measurable_space α} {μ : measure α}

/-
Want to state using `well_approximate`:
For a function ψ : ℕ → ℝ≥0 such that ∑ q, (φ q * ψ q) / q < ∞, μ W = 0
-/

/- Gallagher's Ergodic Theorem -/
example {T : ℝ} [hT : fact (0 < T)] (δ : ℕ → ℝ) (hδ : tendsto δ at_top (nhds 0)) :
(∀ᵐ (x : add_circle T), ¬add_well_approximable (add_circle T) δ x) ∨
 ∀ᵐ (x : add_circle T), add_well_approximable (add_circle T) δ x := sorry

/- Borel-Cantelli Theorem -/
example {p : ℕ → α → Prop} (hp : ∑' i, μ {x | p i x} ≠ ∞) : μ {x | ∃ᶠ n in at_top, p n x} = 0 :=
sorry

/- Duffin-Schaeffer Theorem (Implication) -/
example (α : ℝ) (ψ : ℕ → ℝ≥0) (h : {q : ℚ | |α - q| ≤ ψ (q.denom) / q.denom}.infinite) : _ := sorry

end measure_theory


import analysis.calculus.inverse
import analysis.calculus.cont_diff
import analysis.inner_product_space.calculus
import analysis.inner_product_space.dual

import to_mathlib.analysis.calculus
import to_mathlib.analysis.normed_space.operator_norm

noncomputable theory

open_locale topology filter
open function

section
universes u₁ u₂ u₃ u₄ u₅

open continuous_linear_map

variables {𝕜 : Type u₁} [nontrivially_normed_field 𝕜]
  {M₁ : Type u₂} [normed_add_comm_group M₁] [normed_space 𝕜 M₁]
  {M₂ : Type u₃} [normed_add_comm_group M₂] [normed_space 𝕜 M₂]
  {M₃ : Type u₄} [normed_add_comm_group M₃] [normed_space 𝕜 M₃]
  {M₄ : Type u₅} [normed_add_comm_group M₄] [normed_space 𝕜 M₄]

-- The next definition won't be used here, it's practice before the next one.

/-- Defines continuous linear maps between two products by blocks:
given `(A : M₁ →L[𝕜] M₃)`, `(B : M₂ →L[𝕜] M₃)`, `(C : M₁ →L[𝕜] M₄)` and `(D : M₂ →L[𝕜] M₄)`,
construct the continuous linear map with "matrix":
A B
C D. -/
def continuous_linear_map.blocks (A : M₁ →L[𝕜] M₃) (B : M₂ →L[𝕜] M₃)
  (C : M₁ →L[𝕜] M₄) (D : M₂ →L[𝕜] M₄) : (M₁ × M₂) →L[𝕜] (M₃ × M₄) :=
(A.coprod B).prod (C.coprod D)

/-- Given `(A : M₁ ≃L[𝕜] M₃)`, `(C : M₁ →L[𝕜] M₄)` and `(D : M₂ ≃L[𝕜] M₄)`,
construct the continuous linear equiv with "matrix"
A 0
C D.
  -/
def continuous_linear_equiv.lower_triangular (A : M₁ ≃L[𝕜] M₃)
  (C : M₁ →L[𝕜] M₄) (D : M₂ ≃L[𝕜] M₄) : (M₁ × M₂) ≃L[𝕜] (M₃ × M₄) :=
continuous_linear_equiv.equiv_of_inverse (((A : M₁ →L[𝕜] M₃).comp (fst 𝕜 M₁ M₂)).prod (C.coprod D))
(((A.symm : M₃ →L[𝕜] M₁).comp (fst 𝕜 M₃ M₄)).prod
((-((D.symm : M₄ →L[𝕜] M₂).comp C).comp (A.symm : M₃ →L[𝕜] M₁)).coprod D.symm))
(λ ⟨x, y⟩, by simp only [prod_apply, coe_comp', continuous_linear_equiv.coe_coe, coe_fst', comp_app,
           coprod_apply, continuous_linear_equiv.symm_apply_apply, neg_apply,
           continuous_linear_equiv.map_add, neg_add_cancel_left])
(λ ⟨x, y⟩, by simp only [prod_apply, coe_comp', continuous_linear_equiv.coe_coe, coe_fst', comp_app,
           coprod_apply, neg_apply, continuous_linear_equiv.apply_symm_apply,
           continuous_linear_equiv.map_add, continuous_linear_equiv.map_neg, add_neg_cancel_left])

lemma continuous_linear_equiv.continuous_lower_triangular {X : Type*} [topological_space X]
  {A : X → M₁ ≃L[𝕜] M₃} {C : X → M₁ →L[𝕜] M₄} {D : X → M₂ ≃L[𝕜] M₄}
  (hA : continuous (λ x, (A x : M₁ →L[𝕜] M₃))) (hC : continuous C)
  (hD : continuous (λ x, (D x : M₂ →L[𝕜] M₄))) :
  continuous (λ x, ((A x).lower_triangular (C x) (D x) : (M₁ × M₂) →L[𝕜] (M₃ × M₄))) :=
(hA.compL continuous_const).prodL (hC.coprodL hD)

end

section
variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
  {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]
  {n : ℕ∞}

-- The next two definitions aren't used in the end, but they may still go to mathlib

/-- The proposition that a function between two normed spaces has a strict derivative at a given
point. -/
def strict_differentiable_at (f : E → F) (x) :=
∃ φ : E →L[𝕜] F, has_strict_fderiv_at f φ x

/-- The proposition that a function between two normed spaces has a strict derivative at every
point. -/
def strict_differentiable (f : E → F) :=
∀ x, strict_differentiable_at 𝕜 f x

variables {𝕜}

lemma strict_differentiable_at.differentiable_at {f : E → F} {x : E}
  (h : strict_differentiable_at 𝕜 f x) : differentiable_at 𝕜 f x :=
exists.elim h (λ φ hφ, ⟨φ, hφ.has_fderiv_at⟩)

-- PR to linear_algebra.prod
@[simp]
lemma linear_map.coprod_comp_inl_inr {R : Type*} {M : Type*} {M₂ : Type*} {M₃ : Type*} [semiring R]
  [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [module R M]
  [module R M₂] [module R M₃] (f : M × M₂ →ₗ[R] M₃) :
  (f.comp (linear_map.inl R M M₂)).coprod (f.comp (linear_map.inr R M M₂)) = f :=
by rw [← linear_map.comp_coprod, linear_map.coprod_inl_inr, linear_map.comp_id]

-- PR to topology.algebra.module.basic
@[simp]
lemma continuous_linear_map.coprod_comp_inl_inr {R₁ : Type*} [semiring R₁] {M₁ : Type*} [topological_space M₁]
  [add_comm_monoid M₁] {M₂ : Type*} [topological_space M₂] [add_comm_monoid M₂]
  {M₃ : Type*} [topological_space M₃] [add_comm_monoid M₃] [module R₁ M₁]
  [module R₁ M₂] [module R₁ M₃] [has_continuous_add M₃] (f : M₁ × M₂ →L[R₁] M₃) :
  (f.comp (continuous_linear_map.inl R₁ M₁ M₂)).coprod (f.comp (continuous_linear_map.inr R₁ M₁ M₂)) = f :=
continuous_linear_map.coe_injective (f : M₁ × M₂ →ₗ[R₁] M₃).coprod_comp_inl_inr

lemma differentiable_at.has_fderiv_at_coprod_partial {f : E → F → G} {x : E} {y : F}
  (hf : differentiable_at 𝕜 (uncurry f) (x, y)) :
  has_fderiv_at (uncurry f)
                ((partial_fderiv_fst 𝕜 f x y).coprod (partial_fderiv_snd 𝕜 f x y)) (x, y) :=
begin
  rcases hf with ⟨θ, hθ⟩,
  rwa [fderiv_partial_fst hθ, fderiv_partial_snd hθ, θ.coprod_comp_inl_inr]
end

lemma differentiable_at.has_fderiv_at_coprod {f : E → F → G} {x : E} {y : F}
  (hf : differentiable_at 𝕜 (uncurry f) (x, y)) {φ : E →L[𝕜] G} {ψ : F →L[𝕜] G}
  (hφ : has_fderiv_at (λ p, f p y) φ x) (hψ : has_fderiv_at (f x) ψ y) :
  has_fderiv_at (uncurry f) (φ.coprod ψ) (x, y) :=
begin
  rw [hφ.unique hf.has_fderiv_at_partial_fst, hψ.unique hf.has_fderiv_at_partial_snd],
  exact hf.has_fderiv_at_coprod_partial
end

variables [complete_space E]

lemma homeomorph.cont_diff_at_symm (f : homeomorph E F) {f₀' : E ≃L[𝕜] F} {a : F}
  (hf' : has_fderiv_at f (f₀' : E →L[𝕜] F) (f.symm a)) (hf : cont_diff_at 𝕜 n f (f.symm a)) :
  cont_diff_at 𝕜 n (f.symm) a :=
f.to_local_homeomorph.cont_diff_at_symm trivial hf' hf

lemma equiv.continuous_symm_of_cont_diff (φ : E ≃ F) {Dφ : E → E ≃L[𝕜] F}
  (hφ : ∀ x, has_strict_fderiv_at φ (Dφ x : E →L[𝕜] F) x) :
  continuous φ.symm :=
begin
  rw continuous_iff_continuous_at,
  intros x,
  let y := φ.symm x,
  let g := (hφ y).local_inverse φ (Dφ y) y,
  rw ← φ.apply_symm_apply x,
  have ev_eq : g =ᶠ[𝓝 (φ y)] φ.symm,
  { apply (hφ y).eventually_right_inverse.mono,
    rintros x (hx : φ (g x) = x),
    exact (equiv.eq_symm_apply φ).mpr hx },
  apply continuous_at.congr _ ev_eq,
  apply (hφ y).local_inverse_continuous_at
end

/-- A bijection that is strictly differentiable at every point is a homeomorphism. -/
def equiv.to_homeomorph_of_cont_diff (φ : E ≃ F) {Dφ : E → E ≃L[𝕜] F}
  (hφ : ∀ x, has_strict_fderiv_at φ (Dφ x : E →L[𝕜] F) x) : E ≃ₜ F :=
{ continuous_to_fun := differentiable.continuous (λ x, (hφ x).differentiable_at),
  continuous_inv_fun := φ.continuous_symm_of_cont_diff hφ,
  ..φ}

end

section
variables {𝕜 : Type*} [is_R_or_C 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
  {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]
  {n : ℕ∞}

local notation `∂₁` := partial_fderiv_fst 𝕜
local notation `∂₂` := partial_fderiv_snd 𝕜

lemma cont_diff_parametric_symm [complete_space E] [complete_space F]
  {f : E → F ≃ G} {f' : E → F → F ≃L[𝕜] G}
  (hf : cont_diff 𝕜 ⊤ (λ p : E × F, f p.1 p.2))
  (hf' : ∀ x y, ∂₂ (λ x y, f x y) x y = f' x y) :
  cont_diff 𝕜 ⊤ (λ p : E × G, (f p.1).symm p.2) :=
begin
  let φ₀ : (E × F) ≃ (E × G) :=
  { to_fun := λ p : E × F, (p.1, f p.1 p.2),
    inv_fun := λ p : E × G, (p.1, (f p.1).symm p.2),
    left_inv := λ x, by simp,
    right_inv := λ x, by simp },
  let ff := λ x y, f x y,
  have hff : cont_diff 𝕜 ⊤ (uncurry ff) := hf,
  let d₁f := ∂₁ ff,
  let Dφ : E × F → (E × F) ≃L[𝕜] E × G :=
    λ x, (continuous_linear_equiv.refl 𝕜 E).lower_triangular (d₁f x.1 x.2) (f' x.1 x.2),
  let Dφ' : E × F → (E × F) →L[𝕜] E × G := λ x, Dφ x,
  have hderiv : ∀ (x : E × F), has_strict_fderiv_at φ₀ (Dφ' x) x,
  { rintros p,
    apply has_strict_fderiv_at_of_has_fderiv_at_of_continuous_at,
    { apply filter.eventually_of_forall,
      rintros ⟨x, y⟩,
      apply has_fderiv_at.prod,
      { simp only [continuous_linear_equiv.coe_refl, continuous_linear_map.id_comp,
        has_fderiv_at_fst] },
      have diff : differentiable 𝕜 (uncurry $ λ x y, f x y) := hf.differentiable le_top,
      rw show (λ (x : E × F), (f x.fst) x.snd) = uncurry (λ x y, f x y), by { ext, refl },
      apply differentiable_at.has_fderiv_at_coprod,
      { apply (hf.differentiable le_top) },
      { dsimp [d₁f],
        exact diff.differentiable_at.has_fderiv_at_partial_fst },
      { rw ← hf' x y,
        dsimp,
        exact diff.differentiable_at.has_fderiv_at_partial_snd } },
    { apply continuous.continuous_at,
      apply continuous_linear_equiv.continuous_lower_triangular,
      { exact continuous_const },
      { exact hff.cont_diff_top_partial_fst.continuous },
      { simp_rw ← hf',
        exact hff.cont_diff_top_partial_snd.continuous } } },
  let φ := φ₀.to_homeomorph_of_cont_diff hderiv,
  exact cont_diff_snd.comp (φ.cont_diff_symm (λ x, (hderiv x).has_fderiv_at)
    (cont_diff_fst.prod hf)),
end

end

section
variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]

lemma cont_diff_parametric_symm_of_deriv_pos {f : E → ℝ → ℝ} (hf : cont_diff ℝ ⊤ ↿f)
  (hderiv : ∀ x t, 0 < partial_deriv_snd f x t) (hsurj : ∀ x, surjective $ f x) :
  cont_diff ℝ ⊤  (λ p : E × ℝ, (strict_mono.order_iso_of_surjective (f p.1)
                                (strict_mono_of_deriv_pos $ hderiv p.1) (hsurj p.1)).symm p.2) :=
begin
  have hmono := λ x, strict_mono_of_deriv_pos (hderiv x),
  let F := λ x, (strict_mono.order_iso_of_surjective (f x) (hmono x) $ hsurj x).to_equiv,
  change cont_diff ℝ ⊤ (λ (p : E × ℝ), (F p.1).symm p.snd),
  refine cont_diff_parametric_symm hf _,
  exact λ x t, continuous_linear_equiv.units_equiv_aut ℝ (units.mk0 (deriv (f x) t) $ ne_of_gt (hderiv x t)) ,
  intros x t,
  suffices : partial_fderiv_snd ℝ f x t 1 = partial_deriv_snd f x t,
  { ext v,
    simpa only [rel_iso.coe_fn_to_equiv, continuous_linear_equiv.coe_coe,
      continuous_linear_equiv.units_equiv_aut_apply, units.coe_mk0, one_mul] },
  apply partial_fderiv_snd_one
end

end

section
variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]

lemma cont_diff_to_span_singleton (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] :
  cont_diff 𝕜 ⊤ (continuous_linear_map.to_span_singleton 𝕜 : E → 𝕜 →L[𝕜] E) :=
(continuous_linear_map.lsmul 𝕜 𝕜 : 𝕜 →L[𝕜] E →L[𝕜] E).flip.cont_diff

end

section
variables {𝕜 : Type*} [is_R_or_C 𝕜]
variables {E : Type*} [normed_add_comm_group E] [inner_product_space 𝕜 E] [complete_space E]

-- variant of `orthogonal_projection_singleton`
lemma orthogonal_projection_singleton' {v : E} :
  (𝕜 ∙ v).subtypeL.comp (orthogonal_projection (𝕜 ∙ v))
  = (1 / ‖v‖ ^ 2 : 𝕜) • (continuous_linear_map.to_span_singleton 𝕜 v)
    ∘L inner_product_space.to_dual 𝕜 E v :=
begin
  ext w,
  simp [continuous_linear_map.to_span_singleton_apply, orthogonal_projection_singleton, ← mul_smul],
  congr' 1,
  field_simp,
end

end

section
variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] [complete_space E]

/-- The orthogonal projection onto a vector in a real inner product space `E`, considered as a map
from `E` to `E →L[ℝ] E`, is smooth away from 0. -/
lemma cont_diff_at_orthogonal_projection_singleton {v₀ : E} (hv₀ : v₀ ≠ 0) :
  cont_diff_at ℝ ⊤ (λ v : E, (ℝ ∙ v).subtypeL.comp (orthogonal_projection (ℝ ∙ v))) v₀ :=
begin
  suffices :  cont_diff_at ℝ ⊤
    (λ v : E, (1 / ‖v‖ ^ 2) • continuous_linear_map.to_span_singleton ℝ v
    ∘L inner_product_space.to_dual ℝ E v) v₀,
  { refine this.congr_of_eventually_eq _,
    refine filter.eventually_of_forall (λ v, _),
    dsimp,
    rw orthogonal_projection_singleton',
    refl },
  refine cont_diff_at.smul _ _,
  { refine cont_diff_at_const.div (cont_diff_norm_sq ℝ).cont_diff_at _,
    apply pow_ne_zero,
    exact norm_ne_zero_iff.mpr hv₀ },
  exact (cont_diff.clm_comp (cont_diff_to_span_singleton ℝ E)
    (inner_product_space.to_dual ℝ E).cont_diff).cont_diff_at,
end

end

section arithmetic

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {𝔸 : Type*} [normed_ring 𝔸] [normed_algebra 𝕜 𝔸]
  {n : ℕ∞} {f : E → 𝔸} {s : set E} {x : E}

lemma cont_diff_within_at.mul_const (hf : cont_diff_within_at 𝕜 n f s x) {c : 𝔸} :
  cont_diff_within_at 𝕜 n (λ (x : E), f x * c) s x :=
hf.mul cont_diff_within_at_const

theorem cont_diff_at.mul_const (hf : cont_diff_at 𝕜 n f x) {c : 𝔸} :
  cont_diff_at 𝕜 n (λ (x : E), f x * c) x :=
hf.mul cont_diff_at_const

theorem cont_diff_on.mul_const (hf : cont_diff_on 𝕜 n f s) {c : 𝔸} :
  cont_diff_on 𝕜 n (λ (x : E), f x * c) s :=
hf.mul cont_diff_on_const

theorem cont_diff.mul_const (hf : cont_diff 𝕜 n f) {c : 𝔸} :
  cont_diff 𝕜 n (λ (x : E), f x * c) :=
hf.mul cont_diff_const

end arithmetic


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

! This file was ported from Lean 3 source module data.multiset.dedup
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Nodup

/-!
# Erasing duplicates in a multiset.
-/

namespace Multiset

open List

variable {α β : Type _} [DecidableEq α]

/-! ### dedup -/

/-- `dedup s` removes duplicates from `s`, yielding a `nodup` multiset. -/
def dedup (s : Multiset α) : Multiset α :=
  Quot.liftOn s (fun l => (l.dedup : Multiset α)) fun _ _ p => Quot.sound p.dedup
#align multiset.dedup Multiset.dedup

@[simp]
theorem coe_dedup (l : List α) : @dedup α _ l = l.dedup :=
  rfl
#align multiset.coe_dedup Multiset.coe_dedup

@[simp]
theorem dedup_zero : @dedup α _ 0 = 0 :=
  rfl
#align multiset.dedup_zero Multiset.dedup_zero

@[simp]
theorem mem_dedup {a : α} {s : Multiset α} : a ∈ dedup s ↔ a ∈ s :=
  Quot.induction_on s fun _ => List.mem_dedup
#align multiset.mem_dedup Multiset.mem_dedup

@[simp]
theorem dedup_cons_of_mem {a : α} {s : Multiset α} : a ∈ s → dedup (a ::ₘ s) = dedup s :=
  Quot.induction_on s fun _ m => @congr_arg _ _ _ _ ofList <| List.dedup_cons_of_mem m
#align multiset.dedup_cons_of_mem Multiset.dedup_cons_of_mem

@[simp]
theorem dedup_cons_of_not_mem {a : α} {s : Multiset α} : a ∉ s → dedup (a ::ₘ s) = a ::ₘ dedup s :=
  Quot.induction_on s fun _ m => congr_arg ofList <| List.dedup_cons_of_not_mem m
#align multiset.dedup_cons_of_not_mem Multiset.dedup_cons_of_not_mem

theorem dedup_le (s : Multiset α) : dedup s ≤ s :=
  Quot.induction_on s fun _ => (dedup_sublist _).subperm
#align multiset.dedup_le Multiset.dedup_le

theorem dedup_subset (s : Multiset α) : dedup s ⊆ s :=
  subset_of_le <| dedup_le _
#align multiset.dedup_subset Multiset.dedup_subset

theorem subset_dedup (s : Multiset α) : s ⊆ dedup s := fun _ => mem_dedup.2
#align multiset.subset_dedup Multiset.subset_dedup

@[simp]
theorem dedup_subset' {s t : Multiset α} : dedup s ⊆ t ↔ s ⊆ t :=
  ⟨Subset.trans (subset_dedup _), Subset.trans (dedup_subset _)⟩
#align multiset.dedup_subset' Multiset.dedup_subset'

@[simp]
theorem subset_dedup' {s t : Multiset α} : s ⊆ dedup t ↔ s ⊆ t :=
  ⟨fun h => Subset.trans h (dedup_subset _), fun h => Subset.trans h (subset_dedup _)⟩
#align multiset.subset_dedup' Multiset.subset_dedup'

@[simp]
theorem nodup_dedup (s : Multiset α) : Nodup (dedup s) :=
  Quot.induction_on s List.nodup_dedup
#align multiset.nodup_dedup Multiset.nodup_dedup

theorem dedup_eq_self {s : Multiset α} : dedup s = s ↔ Nodup s :=
  ⟨fun e => e ▸ nodup_dedup s, Quot.induction_on s fun _ h => congr_arg ofList h.dedup⟩
#align multiset.dedup_eq_self Multiset.dedup_eq_self

alias dedup_eq_self ↔ _ Nodup.dedup
#align multiset.nodup.dedup Multiset.Nodup.dedup

theorem count_dedup (m : Multiset α) (a : α) : m.dedup.count a = if a ∈ m then 1 else 0 :=
  Quot.induction_on m fun _ => by
    simp only [quot_mk_to_coe'', coe_dedup, mem_coe, List.mem_dedup, coe_nodup, coe_count]
    apply List.count_dedup _ _
#align multiset.count_dedup Multiset.count_dedup

@[simp]
theorem dedup_idempotent {m : Multiset α} : m.dedup.dedup = m.dedup :=
  Quot.induction_on m fun _ => @congr_arg _ _ _ _ ofList List.dedup_idempotent
#align multiset.dedup_idempotent Multiset.dedup_idempotent

@[simp]
theorem dedup_bind_dedup [DecidableEq β] (m : Multiset α) (f : α → Multiset β) :
    (m.dedup.bind f).dedup = (m.bind f).dedup := by
  ext x
  -- Porting note: was `simp_rw [count_dedup, mem_bind, mem_dedup]`
  simp_rw [count_dedup]
  refine if_congr ?_ rfl rfl
  simp
#align multiset.dedup_bind_dedup Multiset.dedup_bind_dedup

theorem dedup_eq_zero {s : Multiset α} : dedup s = 0 ↔ s = 0 :=
  ⟨fun h => eq_zero_of_subset_zero <| h ▸ subset_dedup _, fun h => h.symm ▸ dedup_zero⟩
#align multiset.dedup_eq_zero Multiset.dedup_eq_zero

@[simp]
theorem dedup_singleton {a : α} : dedup ({a} : Multiset α) = {a} :=
  (nodup_singleton _).dedup
#align multiset.dedup_singleton Multiset.dedup_singleton

theorem le_dedup {s t : Multiset α} : s ≤ dedup t ↔ s ≤ t ∧ Nodup s :=
  ⟨fun h => ⟨le_trans h (dedup_le _), nodup_of_le h (nodup_dedup _)⟩,
   fun ⟨l, d⟩ => (le_iff_subset d).2 <| Subset.trans (subset_of_le l) (subset_dedup _)⟩
#align multiset.le_dedup Multiset.le_dedup

theorem le_dedup_self {s : Multiset α} : s ≤ dedup s ↔ Nodup s := by
  rw [le_dedup, and_iff_right le_rfl]
#align multiset.le_dedup_self Multiset.le_dedup_self

theorem dedup_ext {s t : Multiset α} : dedup s = dedup t ↔ ∀ a, a ∈ s ↔ a ∈ t := by
  simp [Nodup.ext]
#align multiset.dedup_ext Multiset.dedup_ext

theorem dedup_map_dedup_eq [DecidableEq β] (f : α → β) (s : Multiset α) :
    dedup (map f (dedup s)) = dedup (map f s) := by
  simp [dedup_ext]
#align multiset.dedup_map_dedup_eq Multiset.dedup_map_dedup_eq

@[simp]
theorem dedup_nsmul {s : Multiset α} {n : ℕ} (h0 : n ≠ 0) : (n • s).dedup = s.dedup := by
  ext a
  by_cases h : a ∈ s <;> simp [h, h0]
#align multiset.dedup_nsmul Multiset.dedup_nsmul

theorem Nodup.le_dedup_iff_le {s t : Multiset α} (hno : s.Nodup) : s ≤ t.dedup ↔ s ≤ t := by
  simp [le_dedup, hno]
#align multiset.nodup.le_dedup_iff_le Multiset.Nodup.le_dedup_iff_le

end Multiset

theorem Multiset.Nodup.le_nsmul_iff_le {α : Type _} {s t : Multiset α} {n : ℕ} (h : s.Nodup)
    (hn : n ≠ 0) : s ≤ n • t ↔ s ≤ t := by
  classical
    rw [← h.le_dedup_iff_le, Iff.comm, ← h.le_dedup_iff_le]
    simp [hn]
#align multiset.nodup.le_nsmul_iff_le Multiset.Nodup.le_nsmul_iff_le