import data.nat.nth
import topology.metric_space.contracting

universes u v w

/-!
# Ordered families of equivalences

### References
https://plv.mpi-sws.org/iris/appendix-4.0.pdf
-/

/-- An ordered family of equivalences on a type.

Whenever possible, we work with unbundled forms of types,
so that we can make the best of Lean's typeclass inference.
In particular, functors and categorical notions are unbundled and made explicit
wherever possible. -/
class ofe (α : Type u) : Type u :=
(eq_at : ℕ → α → α → Prop)
(eq_at_reflexive : ∀ n, reflexive (eq_at n))
(eq_at_symmetric : ∀ n, symmetric (eq_at n))
(eq_at_transitive : ∀ n, transitive (eq_at n))
(eq_at_mono' : antitone eq_at)
(eq_at_limit' (x y : α) : (∀ n, eq_at n x y) → x = y)

export ofe (eq_at_reflexive eq_at_symmetric eq_at_transitive)

notation a ` =[`:50 n `] ` b:50 := ofe.eq_at n a b

class decidable_eq_at (α : Type u) [ofe α] :=
(prop (x y : α) (n : ℕ) : decidable (x =[n] y))

instance (α : Type u) [ofe α] [decidable_eq_at α] (n : ℕ) (x y : α) : decidable (x =[n] y) :=
decidable_eq_at.prop x y n

lemma eq_at_equivalence {α : Type u} [ofe α] (n : ℕ) :
  equivalence (ofe.eq_at n : α → α → Prop) :=
⟨eq_at_reflexive n, eq_at_symmetric n, eq_at_transitive n⟩

@[refl] lemma eq_at_refl {α : Type u} [ofe α] (n : ℕ) (x : α) :
  x =[n] x := eq_at_reflexive n x

@[symm] lemma eq_at_symm {α : Type u} [ofe α] {n : ℕ} {x y : α} :
  x =[n] y → y =[n] x :=
λ h, eq_at_symmetric n h

@[symm] lemma eq_at_symm_iff {α : Type u} [ofe α] (n : ℕ) (x y : α) :
  x =[n] y ↔ y =[n] x :=
⟨eq_at_symm, eq_at_symm⟩

@[trans] lemma eq_at_trans {α : Type u} [ofe α] {n : ℕ} {x z : α} (y : α) :
  x =[n] y → y =[n] z → x =[n] z :=
λ hxy hyz, eq_at_transitive n hxy hyz

instance {α : Type u} [ofe α] (n : ℕ) : is_refl α (ofe.eq_at n) :=
⟨eq_at_refl n⟩

instance {α : Type u} [ofe α] (n : ℕ) : is_symm α (ofe.eq_at n) :=
⟨eq_at_symmetric n⟩

instance {α : Type u} [ofe α] (n : ℕ) : is_trans α (ofe.eq_at n) :=
⟨eq_at_transitive n⟩

instance {α : Type u} [ofe α] (n : ℕ) : is_preorder α (ofe.eq_at n) := ⟨⟩

instance {α : Type u} [ofe α] (n : ℕ) : is_equiv α (ofe.eq_at n) := ⟨⟩

lemma eq_at_mono {α : Type u} [ofe α] {m n : ℕ} (hmn : m ≤ n) {x y : α} :
  x =[n] y → x =[m] y :=
ofe.eq_at_mono' hmn x y

@[simp] lemma eq_at_max {α : Type u} [ofe α] {m n : ℕ} {x y : α} :
  x =[max m n] y ↔ x =[m] y ∧ x =[n] y :=
begin
  split,
  { intro h,
    split,
    exact eq_at_mono (le_max_left m n) h,
    exact eq_at_mono (le_max_right m n) h, },
  { rintro ⟨h₁, h₂⟩,
    cases max_cases m n; rw h.1; assumption, },
end

lemma eq_at_trans_not {α : Type u} [ofe α] (n : ℕ) (x y z : α) :
  x =[n] y → ¬y =[n] z → ¬x =[n] z :=
begin
  intro h₁,
  contrapose!,
  rw eq_at_symm_iff at h₁,
  intro h₂,
  transitivity x;
  assumption,
end

lemma eq_at_forall_trans {α : Type u} [ofe α] {n : ℕ} {x y z : α} :
  x =[n] y → ∀ k ≤ n, x =[k] z ↔ y =[k] z :=
begin
  intros hxy k hk,
  split,
  { intro hxz,
    refine eq_at_trans x _ hxz,
    rw eq_at_symm_iff,
    exact eq_at_mono hk hxy, },
  { intro hyz,
    refine eq_at_trans y _ hyz,
    exact eq_at_mono hk hxy, },
end

lemma eq_at_forall_trans' {α : Type u} [ofe α] {n : ℕ} {x y z : α} :
  x =[n] y → ¬x =[n] z → ∀ k, x =[k] z ↔ y =[k] z :=
begin
  intros hxy hxz k,
  by_cases k ≤ n,
  { exact eq_at_forall_trans hxy k h, },
  rw eq_at_symm_iff at hxy,
  have := eq_at_trans_not n y x z hxy hxz,
  push_neg at h,
  have h₁ := eq_at_mono h.le,
  have h₂ := eq_at_mono h.le,
  split,
  { intro h, cases hxz (h₁ h), },
  { intro h, cases this (h₂ h), },
end

lemma eq_at_limit {α : Type u} [ofe α] (x y : α) :
  x = y ↔ ∀ n, x =[n] y :=
⟨by rintro rfl a; refl, ofe.eq_at_limit' x y⟩

lemma eq_at_infinite {α : Type u} [ofe α] (x y : α) {s : set ℕ} (h : s.infinite) :
  (∀ n ∈ s, x =[n] y) → x = y :=
begin
  suffices : ∀ n : ℕ, ∃ m : ℕ, n ≤ m ∧ m ∈ s,
  { intro hxy,
    rw eq_at_limit,
    intro n,
    obtain ⟨m, hm₁, hm₂⟩ := this n,
    exact eq_at_mono hm₁ (hxy m hm₂), },
  contrapose! h,
  rw set.not_infinite,
  refine bdd_below.finite_of_bdd_above _ _,
  { refine ⟨0, _⟩,
    intros n hn,
    exact zero_le n, },
  { obtain ⟨n, hn⟩ := h,
    refine ⟨n, _⟩,
    intros m hm,
    contrapose hm,
    exact hn m (le_of_not_le hm), },
end

lemma exists_ne_of_ne {α : Type u} [ofe α] {x y : α} : x ≠ y → ∃ n, ¬x =[n] y :=
by contrapose!; exact (eq_at_limit x y).mpr

lemma ne_of_exists_ne {α : Type u} [ofe α] {x y : α} : (∃ n, ¬x =[n] y) → x ≠ y :=
by contrapose!; exact (eq_at_limit x y).mp

lemma exists_ne_iff_ne {α : Type u} [ofe α] {x y : α} : x ≠ y ↔ ∃ n, ¬x =[n] y :=
⟨exists_ne_of_ne, ne_of_exists_ne⟩

/-- The critical point of two nonequal elements of a type with an OFE is the smallest
time index that finds that the two elements differ. -/
noncomputable def critical_point {α : Type u} [ofe α] {x y : α}
  (h : x ≠ y) : ℕ :=
@nat.find _ (λ _, classical.dec _) (exists_ne_of_ne h)

lemma critical_point_spec {α : Type u} [ofe α] {x y : α} (h : x ≠ y) :
  ¬x =[critical_point h] y :=
@nat.find_spec _ (λ _, classical.dec _) (exists_ne_of_ne h)

lemma critical_point_min {α : Type u} [ofe α] {x y : α} (h : x ≠ y) {m : ℕ} :
  m < critical_point h → x =[m] y :=
λ hm, not_not.mp (@nat.find_min _ (λ _, classical.dec _) (exists_ne_of_ne h) m hm)

lemma critical_point_min' {α : Type u} [ofe α] {x y : α} (h : x ≠ y)
  {m : ℕ} (hm : ¬x =[m] y) : critical_point h ≤ m :=
@nat.find_min' _ (λ _, classical.dec _) (exists_ne_of_ne h) m hm

/-- An equivalent description of the `eq_at` operation on distinct elements
in ordered families of equivalences. -/
lemma eq_at_iff_lt_critical_point {α : Type u} [ofe α] {x y : α} (h : x ≠ y)
  {m : ℕ} : x =[m] y ↔ m < critical_point h :=
begin
  split,
  { intro hm,
    by_contra' this,
    exact critical_point_spec h (eq_at_mono this hm), },
  { intro hm,
    by_contra this,
    exact not_le_of_lt hm (critical_point_min' h this), },
end

lemma critical_point_eq_zero {α : Type u} [ofe α] {x y : α} (h : x ≠ y) :
  critical_point h = 0 ↔ ∀ n, ¬x =[n] y :=
begin
  split,
  { intros hp n hn,
    rw eq_at_iff_lt_critical_point h at hn,
    generalize_proofs at hn,
    rw hp at hn,
    exact nat.not_lt_zero n hn, },
  { intro hp,
    have := critical_point_min' h (hp 0),
    exact le_zero_iff.mp this, },
end

/-- An element of an ordered family of equivalences on a type is *discrete*
if the equivalence at time step zero is equality. -/
def is_discrete {α : Type u} [ofe α] (x : α) : Prop :=
∀ y, x =[0] y → x = y

/-- We can make an OFE on any type which is discrete on all elements. -/
def discrete_ofe (α : Type u) : ofe α := {
  eq_at := λ _, (=),
  eq_at_reflexive := λ _, eq_equivalence.1,
  eq_at_symmetric := λ _, eq_equivalence.2.1,
  eq_at_transitive := λ _, eq_equivalence.2.2,
  eq_at_mono' := λ _ _ _, le_of_eq rfl,
  eq_at_limit' := λ x y h, h 0,
}

@[simp] lemma discrete_ofe_eq_at {α : Type u} (x y : α) (n : ℕ) :
  (discrete_ofe α).eq_at n x y ↔ x = y := iff.rfl

section nonexpansive

/-!
# Nonexpansive and contractive functions

We define nonexpansive and contractive functions, as well as their function classes.
-/

/-- Applying a non-expansive function to some data will not introduce
differences between seemingly equal data. Elements that cannot be distinguished
by programs within `n` steps remain indistinguishable after applying `f`. -/
def is_nonexpansive {α : Type u} {β : Type v} [ofe α] [ofe β] (f : α → β) : Prop :=
∀ ⦃n x y⦄, x =[n] y → f x =[n] f y

lemma is_nonexpansive.apply_eq_at {α : Type u} {β : Type v} [ofe α] [ofe β] {f : α → β}
  (h : is_nonexpansive f) {a b : α} {n : ℕ} (hab : a =[n] b) : f a =[n] f b := h hab

def is_contractive {α : Type u} {β : Type v} [ofe α] [ofe β] (f : α → β) : Prop :=
∀ n ⦃x y⦄, (∀ m < n, x =[m] y) → f x =[n] f y

lemma is_nonexpansive_of_is_contractive {α : Type u} {β : Type v} [ofe α] [ofe β] (f : α → β) :
  is_contractive f → is_nonexpansive f :=
begin
  intros hf n x y h,
  refine hf n _,
  intros m hm,
  exact eq_at_mono hm.le h,
end

@[simp] lemma is_nonexpansive_id {α : Type u} [ofe α] :
  is_nonexpansive (id : α → α) :=
λ n x y h, h

@[simp] lemma is_nonexpansive_comp {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ] (f : β → γ) (g : α → β) :
  is_nonexpansive f → is_nonexpansive g → is_nonexpansive (f ∘ g) :=
λ hf hg n x y h, hf (hg h)

@[ext] structure nonexpansive_fun (α : Type u) (β : Type v) [ofe α] [ofe β] : Type (max u v) :=
(to_fun : α → β)
(is_nonexpansive' : is_nonexpansive to_fun)

class nonexpansive_fun_class (F : Type w) (α : Type u) (β : Type v) [ofe α] [ofe β]
  extends fun_like F α (λ _, β) :=
(is_nonexpansive : ∀ (f : F), is_nonexpansive f)

instance nonexpansive_fun.nonexpansive_fun_class {α : Type u} {β : Type v} [ofe α] [ofe β] :
  nonexpansive_fun_class (nonexpansive_fun α β) α β := {
  coe := nonexpansive_fun.to_fun,
  coe_injective' := begin intros f g h, ext1, exact h, end,
  is_nonexpansive := nonexpansive_fun.is_nonexpansive',
}

instance (F : Type w) (α : Type u) (β : Type v) [ofe α] [ofe β] [nonexpansive_fun_class F α β] :
  has_coe_t F (nonexpansive_fun α β) :=
⟨λ f, { to_fun := f, is_nonexpansive' := nonexpansive_fun_class.is_nonexpansive f }⟩

/-- Nonexpansive functions are nonexpansive. -/
lemma nonexpansive {α : Type u} {β : Type v} [ofe α] [ofe β] {F : Type w}
  [nonexpansive_fun_class F α β] (f : F) : is_nonexpansive f :=
nonexpansive_fun_class.is_nonexpansive f

infixr ` →ₙₑ `:25 := nonexpansive_fun

@[simp] lemma nonexpansive_fun.coe_fn_mk (α : Type u) (β : Type v) [ofe α] [ofe β]
  (f : α → β) (hf : is_nonexpansive f) : ((⟨f, hf⟩ : α →ₙₑ β) : α → β) = f := rfl

def nonexpansive_fun.id (α : Type u) [ofe α] : α →ₙₑ α :=
⟨id, is_nonexpansive_id⟩

def nonexpansive_fun.comp {α : Type u} {β : Type v} {γ : Type w} [ofe α] [ofe β] [ofe γ]
  (f : β →ₙₑ γ) (g : α →ₙₑ β) : α →ₙₑ γ :=
⟨f ∘ g, is_nonexpansive_comp f g f.is_nonexpansive' g.is_nonexpansive'⟩

@[simp] lemma nonexpansive_fun.to_fun_eq_coe_fn {α : Type u} {β : Type v} [ofe α] [ofe β]
  (f : α →ₙₑ β) : f.to_fun = f := rfl

@[simp] lemma is_contractive_comp {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ] (f : β → γ) (g : α → β) :
  is_contractive f → is_contractive g → is_contractive (f ∘ g) :=
λ hf hg n x y h, hf n (λ m hm, hg m (λ k hk, eq_at_mono hk.le (h m hm)))

@[ext] structure contractive_fun (α : Type u) (β : Type v) [ofe α] [ofe β] :=
(to_fun : α → β)
(is_contractive' : is_contractive to_fun)

class contractive_fun_class (F : Type w) (α : Type u) (β : Type v) [ofe α] [ofe β]
  extends fun_like F α (λ _, β) :=
(is_contractive : ∀ (f : F), is_contractive f)

/-- Contractive functions are nonexpansive. -/
instance contractive_fun_class.nonexpansive_fun_class {α : Type u} {β : Type v}
  [ofe α] [ofe β] {F : Type w} [contractive_fun_class F α β] : nonexpansive_fun_class F α β := {
  is_nonexpansive :=
    λ f, is_nonexpansive_of_is_contractive f (contractive_fun_class.is_contractive f),
}

instance contractive_fun.contractive_fun_class {α : Type u} {β : Type v} [ofe α] [ofe β] :
  contractive_fun_class (contractive_fun α β) α β := {
  coe := contractive_fun.to_fun,
  coe_injective' := begin intros f g h, ext1, exact h, end,
  is_contractive := contractive_fun.is_contractive',
}

instance (F : Type w) (α : Type u) (β : Type v) [ofe α] [ofe β] [contractive_fun_class F α β] :
  has_coe_t F (contractive_fun α β) :=
⟨λ f, { to_fun := f, is_contractive' := contractive_fun_class.is_contractive f }⟩

/-- Contractive functions are contractive. -/
lemma contractive {α : Type u} {β : Type v} [ofe α] [ofe β] {F : Type w}
  [contractive_fun_class F α β] (f : F) : is_contractive f :=
contractive_fun_class.is_contractive f

infixr ` →ₖ `:25 := contractive_fun

@[simp] lemma contractive_fun.to_fun_eq_coe_fn {α : Type u} {β : Type v} [ofe α] [ofe β]
  (f : α →ₖ β) : f.to_fun = f := rfl

/-- The critical point of two different objects can never increase
when applying a nonexpansive function. -/
lemma critical_point_nonexpansive {α : Type u} {β : Type v} [ofe α] [ofe β] {F : Type w}
  [nonexpansive_fun_class F α β] (f : F) {x y : α} (hxy : f x ≠ f y) :
  critical_point (ne_of_apply_ne f hxy) ≤ critical_point hxy :=
begin
  refine critical_point_min' _ _,
  intro h,
  have := nonexpansive f h,
  exact critical_point_spec _ this,
end

/-- The critical point of two different objects decreases when
applying a contractive function. -/
lemma critical_point_contractive {α : Type u} {β : Type v} [ofe α] [ofe β] {F : Type w}
  [contractive_fun_class F α β] (f : F) {x y : α} (hxy : f x ≠ f y) :
  critical_point (ne_of_apply_ne f hxy) < critical_point hxy :=
begin
  rw ← eq_at_iff_lt_critical_point,
  refine contractive f (critical_point _) _,
  intros m hm,
  rw eq_at_iff_lt_critical_point (ne_of_apply_ne f hxy),
  exact hm,
end

end nonexpansive

/-- The space of nonexpansive functions forms an OFE. -/
instance nonexpansive_fun.ofe {α : Type u} {β : Type v} [ofe α] [ofe β]
  {F : Type w} [nonexpansive_fun_class F α β] : ofe F := {
  eq_at := λ n f g, ∀ x, f x =[n] g x,
  eq_at_reflexive := begin
    intros n f a,
    refl,
  end,
  eq_at_symmetric := begin
    intros n f g h x,
    rw eq_at_symm_iff,
    exact h x,
  end,
  eq_at_transitive := begin
    intros n f g h hfg hgh x,
    transitivity g x,
    exact hfg x,
    exact hgh x,
  end,
  eq_at_mono' := begin
    intros m n hmn f g h x,
    refine eq_at_mono hmn _,
    exact h x,
  end,
  eq_at_limit' := begin
    intros f g h,
    refine fun_like.coe_injective _,
    ext x,
    rw eq_at_limit,
    intro n,
    exact h n x,
  end,
}

/-!
# Locally nonexpansive functors
-/

/-- We define the notion of an OFE functor explicitly without appealing to mathlib's category
theory library in order to avoid unnecessarily complicated bundled types for this use case. -/
structure ofe_functor :=
(obj : Type u → Type u)
[ofe_obj : Π (α : Type u) [ofe α], ofe (obj α)]
(map : Π {α β : Type u} [ofe α] [ofe β], (α →ₙₑ β) → (obj α →ₙₑ obj β))
(map_id : ∀ (α : Type u) [ofe α], map (nonexpansive_fun.id α) = nonexpansive_fun.id (obj α))
(map_comp : ∀ {α β γ : Type u} [ofe α] [ofe β] [ofe γ] (f : β →ₙₑ γ) (g : α →ₙₑ β),
  map (f.comp g) = (map f).comp (map g))

/-- A contravariant-covariant bifunctor `Ofeᵒᵖ × Ofe ⥤ Ofe`. -/
structure ofe_bifunctor :=
(obj : Π (α : Type u) (β : Type u) [ofe α] [ofe β], Type u)
[ofe_obj : Π (α : Type u) (β : Type u) [ofe α] [ofe β], ofe (obj α β)]
(map : Π {α β γ δ : Type u} [ofe α] [ofe β] [ofe γ] [ofe δ],
  (γ →ₙₑ α) → (β →ₙₑ δ) → (obj α β →ₙₑ obj γ δ))
(map_id : ∀ (α β : Type u) [ofe α] [ofe β],
  map (nonexpansive_fun.id α) (nonexpansive_fun.id β) = nonexpansive_fun.id (obj α β))
(map_comp : ∀ {α β γ δ ε ζ : Type u}
  [ofe α] [ofe β] [ofe γ] [ofe δ] [ofe ε] [ofe ζ]
  (fαβ : α →ₙₑ β) (fβγ : β →ₙₑ γ) (fδε : δ →ₙₑ ε) (fεζ : ε →ₙₑ ζ),
  map (fβγ.comp fαβ) (fεζ.comp fδε) = (map fαβ fεζ).comp (map fβγ fδε))

def locally_nonexpansive_functor (F : ofe_functor) : Prop :=
∀ (α β : Type u) [ofe α] [ofe β],
begin
  resetI,
  letI := F.ofe_obj α,
  letI := F.ofe_obj β,
  exact is_nonexpansive (F.map : (α →ₙₑ β) → (F.obj α →ₙₑ F.obj β))
end

def locally_contractive_functor (F : ofe_functor) : Prop :=
∀ (α β : Type u) [ofe α] [ofe β],
begin
  resetI,
  letI := F.ofe_obj α,
  letI := F.ofe_obj β,
  exact is_contractive (F.map : (α →ₙₑ β) → (F.obj α →ₙₑ F.obj β))
end

lemma nonexpansive_fun.congr_arg {α : Type u} {β : Type v} [ofe α] [ofe β]
  {F : Type w} [nonexpansive_fun_class F α β] {f : F}
  {a b : α} (n : ℕ) : a =[n] b → f a =[n] f b :=
λ h, nonexpansive f h

lemma nonexpansive_fun.congr_fun {α : Type u} {β : Type v} [ofe α] [ofe β]
  {F : Type w} [nonexpansive_fun_class F α β] {f g : F}
  {a : α} (n : ℕ) : f =[n] g → f a =[n] g a :=
λ h, h a

lemma nonexpansive_fun.congr {α : Type u} {β : Type v} [ofe α] [ofe β]
  {F : Type w} [nonexpansive_fun_class F α β] {f g : F}
  {a b : α} (n : ℕ) : f =[n] g → a =[n] b → f a =[n] g b :=
begin
  intros h₁ h₂,
  transitivity g a,
  exact h₁ a,
  exact nonexpansive g h₂,
end

lemma nonexpansive_fun.comp_is_nonexpansive {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ] (f : β →ₙₑ γ) : is_nonexpansive (f.comp : (α →ₙₑ β) → α →ₙₑ γ) :=
begin
  intros n g h hgh a,
  refine nonexpansive f _,
  exact hgh a,
end

lemma nonexpansive_fun.congr_fun_comp {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ]
  {F : Type*} [nonexpansive_fun_class F β γ] {f₁ f₂ : F}
  {G : Type*} [nonexpansive_fun_class G α β] {g₁ g₂ : G}
  {a : α} (n : ℕ) : f₁ =[n] f₂ → g₁ =[n] g₂ → f₁ (g₁ a) =[n] f₂ (g₂ a) :=
begin
  intros h₁ h₂,
  transitivity f₁ (g₂ a),
  exact nonexpansive f₁ (h₂ a),
  exact h₁ _,
end

lemma nonexpansive_fun.comp_left_eq_at {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ] {f : β →ₙₑ γ} {g h : α →ₙₑ β} {n : ℕ} :
  g =[n] h → f.comp g =[n] f.comp h :=
λ hgh, nonexpansive_fun.comp_is_nonexpansive f hgh

lemma nonexpansive_fun.comp_right_eq_at {α : Type u} {β : Type v} {γ : Type w}
  [ofe α] [ofe β] [ofe γ] {f g : β →ₙₑ γ} {h : α →ₙₑ β} {n : ℕ} :
  f =[n] g → f.comp h =[n] g.comp h :=
λ hfg a, hfg (h a)


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.perm.basic
import data.fintype.basic
import group_theory.subgroup
/-!
# Lemmas about subgroups within the permutations (self-equivalences) of a type `α`

This file provides extra lemmas about some `subgroup`s that exist within `equiv.perm α`.
`group_theory.subgroup` depends on `group_theory.perm.basic`, so these need to be in a separate
file.

It also provides decidable instances on membership in these subgroups, since
`monoid_hom.decidable_mem_range` cannot be inferred without the help of a lambda.
The presence of these instances induces a `fintype` instance on the `quotient_group.quotient` of
these subgroups.
-/

namespace equiv
namespace perm

universes u

instance sum_congr_hom.decidable_mem_range {α β : Type*}
  [decidable_eq α] [decidable_eq β] [fintype α] [fintype β] :
  decidable_pred (λ x, x ∈ (sum_congr_hom α β).range) :=
λ x, infer_instance

@[simp]
lemma sum_congr_hom.card_range {α β : Type*}
  [fintype (sum_congr_hom α β).range] [fintype (perm α × perm β)] :
  fintype.card (sum_congr_hom α β).range = fintype.card (perm α × perm β) :=
fintype.card_eq.mpr ⟨(of_injective (sum_congr_hom α β) sum_congr_hom_injective).symm⟩

instance sigma_congr_right_hom.decidable_mem_range {α : Type*} {β : α → Type*}
  [decidable_eq α] [∀ a, decidable_eq (β a)] [fintype α] [∀ a, fintype (β a)] :
  decidable_pred (λ x, x ∈ (sigma_congr_right_hom β).range) :=
λ x, infer_instance

@[simp]
lemma sigma_congr_right_hom.card_range {α : Type*} {β : α → Type*}
  [fintype (sigma_congr_right_hom β).range] [fintype (Π a, perm (β a))] :
  fintype.card (sigma_congr_right_hom β).range = fintype.card (Π a, perm (β a)) :=
fintype.card_eq.mpr ⟨(of_injective (sigma_congr_right_hom β) sigma_congr_right_hom_injective).symm⟩

instance subtype_congr_hom.decidable_mem_range {α : Type*} (p : α → Prop) [decidable_pred p]
  [fintype (perm {a // p a} × perm {a // ¬ p a})] [decidable_eq (perm α)] :
  decidable_pred (λ x, x ∈ (subtype_congr_hom p).range) :=
λ x, infer_instance

@[simp]
lemma subtype_congr_hom.card_range {α : Type*} (p : α → Prop) [decidable_pred p]
  [fintype (subtype_congr_hom p).range] [fintype (perm {a // p a} × perm {a // ¬ p a})] :
  fintype.card (subtype_congr_hom p).range = fintype.card (perm {a // p a} × perm {a // ¬ p a}) :=
fintype.card_eq.mpr ⟨(of_injective (subtype_congr_hom p) (subtype_congr_hom_injective p)).symm⟩

end perm
end equiv


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.preserves.shapes.binary_products
import category_theory.limits.preserves.shapes.products
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.finite_products
import category_theory.pempty
import logic.equiv.fin

/-!
# Constructing finite products from binary products and terminal.

If a category has binary products and a terminal object then it has finite products.
If a functor preserves binary products and the terminal object then it preserves finite products.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

universes v u u'

noncomputable theory
open category_theory category_theory.category category_theory.limits
namespace category_theory

variables {J : Type v} [small_category J]
variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v} D]

/--
Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and
`f 0`, we can build a fan for all `n+1`.

In `extend_fan_is_limit` we show that if the two given fans are limits, then this fan is also a
limit.
-/
@[simps {rhs_md := semireducible}]
def extend_fan {n : ℕ} {f : ulift (fin (n+1)) → C}
  (c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩))
  (c₂ : binary_fan (f ⟨0⟩) c₁.X) :
  fan f :=
fan.mk c₂.X
begin
  rintro ⟨i⟩,
  revert i,
  refine fin.cases _ _,
  { apply c₂.fst },
  { intro i,
    apply c₂.snd ≫ c₁.π.app (ulift.up i) },
end

/--
Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a
limit.
-/
def extend_fan_is_limit {n : ℕ} (f : ulift (fin (n+1)) → C)
  {c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_fan (f ⟨0⟩) c₁.X}
  (t₁ : is_limit c₁) (t₂ : is_limit c₂) :
  is_limit (extend_fan c₁ c₂) :=
{ lift := λ s,
  begin
    apply (binary_fan.is_limit.lift' t₂ (s.π.app ⟨0⟩) _).1,
    apply t₁.lift ⟨_, discrete.nat_trans (λ i, s.π.app ⟨i.down.succ⟩)⟩
  end,
  fac' := λ s,
  begin
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (binary_fan.is_limit.lift' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_fan_π_app],
      rw [fin.cases_succ, ← assoc, (binary_fan.is_limit.lift' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_fan.is_limit.hom_ext t₂,
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      rw assoc,
      dsimp only [discrete.nat_trans_app],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_fan_π_app],
      rw fin.cases_succ }
  end }

section
variables [has_binary_products.{v} C] [has_terminal C]

/--
If `C` has a terminal object and binary products, then it has a product for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_product_ulift_fin :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_product f
| 0 := λ f,
  begin
    letI : has_limits_of_shape (discrete (ulift.{v} (fin 0))) C :=
      has_limits_of_shape_of_equivalence
        (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_product_ulift_fin n,
    apply has_limit.mk ⟨_, extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)⟩,
  end

/--
If `C` has a terminal object and binary products, then it has limits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_limits_of_shape_ulift_fin (n : ℕ) :
  has_limits_of_shape (discrete (ulift.{v} (fin n))) C :=
{ has_limit := λ K,
begin
  letI := has_product_ulift_fin n K.obj,
  let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
  apply has_limit_of_iso this,
end }

/-- If `C` has a terminal object and binary products, then it has finite products. -/
lemma has_finite_products_of_has_binary_and_terminal : has_finite_products C :=
⟨λ J 𝒥₁ 𝒥₂, begin
  resetI,
  let e := fintype.equiv_fin J,
  apply has_limits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
  refine has_limits_of_shape_ulift_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_limits_of_shape (discrete.{v} walking_pair) F]
variables [preserves_limits_of_shape (discrete.{v} pempty) F]
variables [has_finite_products.{v} C]

/--
If `F` preserves the terminal object and binary products, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_terminal  :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), preserves_limit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_limits_of_shape (discrete (ulift (fin 0))) F :=
      preserves_limits_of_shape_of_equiv.{v v}
        (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_terminal n,
    intro f,
    refine preserves_limit_of_preserves_limit_cone
      (extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)) _,
    apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _,
    let := extend_fan_is_limit (λ i, F.obj (f i))
              (is_limit_of_has_product_of_preserves_limit F _)
              (is_limit_of_has_binary_product_of_preserves_limit F _ _),
    refine is_limit.of_iso_limit this _,
    apply cones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (category.id_comp _).symm },
    { rintro i -,
      dsimp only [extend_fan_π_app, iso.refl_hom, fan.mk_π_app],
      rw [fin.cases_succ, fin.cases_succ],
      change F.map _ ≫ _ = 𝟙 _ ≫ _,
      rw [id_comp, ←F.map_comp],
      refl }
  end

/--
If `F` preserves the terminal object and binary products, then it preserves limits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_terminal (n : ℕ) :
  preserves_limits_of_shape (discrete (ulift (fin n))) F :=
{ preserves_limit := λ K,
  begin
    let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_terminal F n K.obj,
    apply preserves_limit_of_iso_diagram F this,
  end }

/-- If `F` preserves the terminal object and binary products then it preserves finite products. -/
def preserves_finite_products_of_preserves_binary_and_terminal
  (J : Type v) [fintype J] :
  preserves_limits_of_shape.{v} (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_ulift_fin_of_preserves_binary_and_terminal F (fintype.card J),
  apply preserves_limits_of_shape_of_equiv.{v v}
    (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
end

end preserves

/--
Given `n+1` objects of `C`, a cofan for the last `n` with point `c₁.X`
and a binary cofan on `c₁.X` and `f 0`, we can build a cofan for all `n+1`.

In `extend_cofan_is_colimit` we show that if the two given cofans are colimits,
then this cofan is also a colimit.
-/
@[simps {rhs_md := semireducible}]
def extend_cofan {n : ℕ} {f : ulift (fin (n+1)) → C}
  (c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩))
  (c₂ : binary_cofan (f ⟨0⟩) c₁.X) :
  cofan f :=
cofan.mk c₂.X
begin
  rintro ⟨i⟩,
  revert i,
  refine fin.cases _ _,
  { apply c₂.inl },
  { intro i,
    apply c₁.ι.app (ulift.up i) ≫ c₂.inr },
end

/--
Show that if the two given cofans in `extend_cofan` are colimits,
then the constructed cofan is also a colimit.
-/
def extend_cofan_is_colimit {n : ℕ} (f : ulift (fin (n+1)) → C)
  {c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_cofan (f ⟨0⟩) c₁.X}
  (t₁ : is_colimit c₁) (t₂ : is_colimit c₂) :
  is_colimit (extend_cofan c₁ c₂) :=
{ desc := λ s,
  begin
    apply (binary_cofan.is_colimit.desc' t₂ (s.ι.app ⟨0⟩) _).1,
    apply t₁.desc ⟨_, discrete.nat_trans (λ i, s.ι.app ⟨i.down.succ⟩)⟩
  end,
  fac' := λ s,
  begin
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (binary_cofan.is_colimit.desc' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc, (binary_cofan.is_colimit.desc' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_cofan.is_colimit.hom_ext t₂,
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      dsimp only [discrete.nat_trans_app],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc], }
  end }

section
variables [has_binary_coproducts.{v} C] [has_initial C]

/--
If `C` has an initial object and binary coproducts, then it has a coproduct for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_coproduct_ulift_fin :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_coproduct f
| 0 := λ f,
  begin
    letI : has_colimits_of_shape (discrete (ulift.{v} (fin 0))) C :=
      has_colimits_of_shape_of_equivalence
        (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_coproduct_ulift_fin n,
    apply has_colimit.mk
      ⟨_, extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)⟩,
  end

/--
If `C` has an initial object and binary coproducts, then it has colimits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_colimits_of_shape_ulift_fin (n : ℕ) :
  has_colimits_of_shape (discrete (ulift.{v} (fin n))) C :=
{ has_colimit := λ K,
begin
  letI := has_coproduct_ulift_fin n K.obj,
  let : K ≅ discrete.functor K.obj := discrete.nat_iso (λ i, iso.refl _),
  apply has_colimit_of_iso this,
end }

/-- If `C` has an initial object and binary coproducts, then it has finite coproducts. -/
lemma has_finite_coproducts_of_has_binary_and_terminal : has_finite_coproducts C :=
⟨λ J 𝒥₁ 𝒥₂, begin
  resetI,
  let e := fintype.equiv_fin J,
  apply has_colimits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
  refine has_colimits_of_shape_ulift_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_colimits_of_shape (discrete.{v} walking_pair) F]
variables [preserves_colimits_of_shape (discrete.{v} pempty) F]
variables [has_finite_coproducts.{v} C]

/--
If `F` preserves the initial object and binary coproducts, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_initial  :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), preserves_colimit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_colimits_of_shape (discrete (ulift (fin 0))) F :=
      preserves_colimits_of_shape_of_equiv.{v v}
        (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_initial n,
    intro f,
    refine preserves_colimit_of_preserves_colimit_cocone
      (extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)) _,
    apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _,
    let := extend_cofan_is_colimit (λ i, F.obj (f i))
              (is_colimit_of_has_coproduct_of_preserves_colimit F _)
              (is_colimit_of_has_binary_coproduct_of_preserves_colimit F _ _),
    refine is_colimit.of_iso_colimit this _,
    apply cocones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply category.comp_id },
    { rintro i -,
      dsimp only [extend_cofan_ι_app, iso.refl_hom, cofan.mk_ι_app],
      rw [fin.cases_succ, fin.cases_succ],
      erw [comp_id, ←F.map_comp],
      refl, }
  end

/--
If `F` preserves the initial object and binary coproducts, then it preserves colimits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_initial (n : ℕ) :
  preserves_colimits_of_shape (discrete (ulift (fin n))) F :=
{ preserves_colimit := λ K,
  begin
    let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_initial F n K.obj,
    apply preserves_colimit_of_iso_diagram F this,
  end }

/-- If `F` preserves the initial object and binary coproducts then it preserves finite products. -/
def preserves_finite_coproducts_of_preserves_binary_and_initial
  (J : Type v) [fintype J] :
  preserves_colimits_of_shape.{v} (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_ulift_fin_of_preserves_binary_and_initial F (fintype.card J),
  apply preserves_colimits_of_shape_of_equiv.{v v}
    (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
end

end preserves

end category_theory


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.PostPort

universes u v w z

namespace Mathlib

namespace list

/- forall₂ -/

theorem forall₂_iff {α : Type u} {β : Type v} (R : α → β → Prop) :
    ∀ (ᾰ : List α) (ᾰ_1 : List β),
        forall₂ R ᾰ ᾰ_1 ↔
          ᾰ = [] ∧ ᾰ_1 = [] ∨
            Exists
              fun {a : α} =>
                Exists
                  fun {b : β} =>
                    Exists
                      fun {l₁ : List α} =>
                        Exists
                          fun {l₂ : List β} =>
                            R a b ∧ forall₂ R l₁ l₂ ∧ ᾰ = a :: l₁ ∧ ᾰ_1 = b :: l₂ :=
  sorry

@[simp] theorem forall₂_cons {α : Type u} {β : Type v} {R : α → β → Prop} {a : α} {b : β}
    {l₁ : List α} {l₂ : List β} : forall₂ R (a :: l₁) (b :: l₂) ↔ R a b ∧ forall₂ R l₁ l₂ :=
  sorry

theorem forall₂.imp {α : Type u} {β : Type v} {R : α → β → Prop} {S : α → β → Prop}
    (H : ∀ (a : α) (b : β), R a b → S a b) {l₁ : List α} {l₂ : List β} (h : forall₂ R l₁ l₂) :
    forall₂ S l₁ l₂ :=
  sorry

theorem forall₂.mp {α : Type u} {β : Type v} {r : α → β → Prop} {q : α → β → Prop}
    {s : α → β → Prop} (h : ∀ (a : α) (b : β), r a b → q a b → s a b) {l₁ : List α} {l₂ : List β} :
    forall₂ r l₁ l₂ → forall₂ q l₁ l₂ → forall₂ s l₁ l₂ :=
  sorry

theorem forall₂.flip {α : Type u} {β : Type v} {r : α → β → Prop} {a : List α} {b : List β} :
    forall₂ (flip r) b a → forall₂ r a b :=
  sorry

theorem forall₂_same {α : Type u} {r : α → α → Prop} {l : List α} :
    (∀ (x : α), x ∈ l → r x x) → forall₂ r l l :=
  sorry

theorem forall₂_refl {α : Type u} {r : α → α → Prop} [is_refl α r] (l : List α) : forall₂ r l l :=
  forall₂_same fun (a : α) (h : a ∈ l) => is_refl.refl a

theorem forall₂_eq_eq_eq {α : Type u} : forall₂ Eq = Eq := sorry

@[simp] theorem forall₂_nil_left_iff {α : Type u} {β : Type v} {r : α → β → Prop} {l : List β} :
    forall₂ r [] l ↔ l = [] :=
  sorry

@[simp] theorem forall₂_nil_right_iff {α : Type u} {β : Type v} {r : α → β → Prop} {l : List α} :
    forall₂ r l [] ↔ l = [] :=
  sorry

theorem forall₂_cons_left_iff {α : Type u} {β : Type v} {r : α → β → Prop} {a : α} {l : List α}
    {u : List β} :
    forall₂ r (a :: l) u ↔ ∃ (b : β), ∃ (u' : List β), r a b ∧ forall₂ r l u' ∧ u = b :: u' :=
  sorry

theorem forall₂_cons_right_iff {α : Type u} {β : Type v} {r : α → β → Prop} {b : β} {l : List β}
    {u : List α} :
    forall₂ r u (b :: l) ↔ ∃ (a : α), ∃ (u' : List α), r a b ∧ forall₂ r u' l ∧ u = a :: u' :=
  sorry

theorem forall₂_and_left {α : Type u} {β : Type v} {r : α → β → Prop} {p : α → Prop} (l : List α)
    (u : List β) :
    forall₂ (fun (a : α) (b : β) => p a ∧ r a b) l u ↔ (∀ (a : α), a ∈ l → p a) ∧ forall₂ r l u :=
  sorry

@[simp] theorem forall₂_map_left_iff {α : Type u} {β : Type v} {γ : Type w} {r : α → β → Prop}
    {f : γ → α} {l : List γ} {u : List β} :
    forall₂ r (map f l) u ↔ forall₂ (fun (c : γ) (b : β) => r (f c) b) l u :=
  sorry

@[simp] theorem forall₂_map_right_iff {α : Type u} {β : Type v} {γ : Type w} {r : α → β → Prop}
    {f : γ → β} {l : List α} {u : List γ} :
    forall₂ r l (map f u) ↔ forall₂ (fun (a : α) (c : γ) => r a (f c)) l u :=
  sorry

theorem left_unique_forall₂ {α : Type u} {β : Type v} {r : α → β → Prop}
    (hr : relator.left_unique r) : relator.left_unique (forall₂ r) :=
  sorry

theorem right_unique_forall₂ {α : Type u} {β : Type v} {r : α → β → Prop}
    (hr : relator.right_unique r) : relator.right_unique (forall₂ r) :=
  sorry

theorem bi_unique_forall₂ {α : Type u} {β : Type v} {r : α → β → Prop} (hr : relator.bi_unique r) :
    relator.bi_unique (forall₂ r) :=
  { left := fun (a : List α) (b : List β) (c : List α) => left_unique_forall₂ (and.left hr),
    right := fun (a : List α) (b c : List β) => right_unique_forall₂ (and.right hr) }

theorem forall₂_length_eq {α : Type u} {β : Type v} {R : α → β → Prop} {l₁ : List α} {l₂ : List β} :
    forall₂ R l₁ l₂ → length l₁ = length l₂ :=
  sorry

theorem forall₂_zip {α : Type u} {β : Type v} {R : α → β → Prop} {l₁ : List α} {l₂ : List β} :
    forall₂ R l₁ l₂ → ∀ {a : α} {b : β}, (a, b) ∈ zip l₁ l₂ → R a b :=
  sorry

theorem forall₂_iff_zip {α : Type u} {β : Type v} {R : α → β → Prop} {l₁ : List α} {l₂ : List β} :
    forall₂ R l₁ l₂ ↔ length l₁ = length l₂ ∧ ∀ {a : α} {b : β}, (a, b) ∈ zip l₁ l₂ → R a b :=
  sorry

theorem forall₂_take {α : Type u} {β : Type v} {R : α → β → Prop} (n : ℕ) {l₁ : List α}
    {l₂ : List β} : forall₂ R l₁ l₂ → forall₂ R (take n l₁) (take n l₂) :=
  sorry

theorem forall₂_drop {α : Type u} {β : Type v} {R : α → β → Prop} (n : ℕ) {l₁ : List α}
    {l₂ : List β} : forall₂ R l₁ l₂ → forall₂ R (drop n l₁) (drop n l₂) :=
  sorry

theorem forall₂_take_append {α : Type u} {β : Type v} {R : α → β → Prop} (l : List α) (l₁ : List β)
    (l₂ : List β) (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (take (length l₁) l) l₁ :=
  (fun (h' : forall₂ R (take (length l₁) l) (take (length l₁) (l₁ ++ l₂))) =>
      eq.mp
        (Eq._oldrec (Eq.refl (forall₂ R (take (length l₁) l) (take (length l₁) (l₁ ++ l₂))))
          (take_left l₁ l₂))
        h')
    (forall₂_take (length l₁) h)

theorem forall₂_drop_append {α : Type u} {β : Type v} {R : α → β → Prop} (l : List α) (l₁ : List β)
    (l₂ : List β) (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (drop (length l₁) l) l₂ :=
  (fun (h' : forall₂ R (drop (length l₁) l) (drop (length l₁) (l₁ ++ l₂))) =>
      eq.mp
        (Eq._oldrec (Eq.refl (forall₂ R (drop (length l₁) l) (drop (length l₁) (l₁ ++ l₂))))
          (drop_left l₁ l₂))
        h')
    (forall₂_drop (length l₁) h)

theorem rel_mem {α : Type u} {β : Type v} {r : α → β → Prop} (hr : relator.bi_unique r) :
    relator.lift_fun r (forall₂ r ⇒ Iff) has_mem.mem has_mem.mem :=
  sorry

theorem rel_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type z} {r : α → β → Prop}
    {p : γ → δ → Prop} : relator.lift_fun (r ⇒ p) (forall₂ r ⇒ forall₂ p) map map :=
  sorry

theorem rel_append {α : Type u} {β : Type v} {r : α → β → Prop} :
    relator.lift_fun (forall₂ r) (forall₂ r ⇒ forall₂ r) append append :=
  sorry

theorem rel_join {α : Type u} {β : Type v} {r : α → β → Prop} :
    relator.lift_fun (forall₂ (forall₂ r)) (forall₂ r) join join :=
  sorry

theorem rel_bind {α : Type u} {β : Type v} {γ : Type w} {δ : Type z} {r : α → β → Prop}
    {p : γ → δ → Prop} :
    relator.lift_fun (forall₂ r) ((r ⇒ forall₂ p) ⇒ forall₂ p) list.bind list.bind :=
  fun (a : List α) (b : List β) (h₁ : forall₂ r a b) (f : α → List γ) (g : β → List δ)
    (h₂ : relator.lift_fun r (forall₂ p) f g) => rel_join (rel_map h₂ h₁)

theorem rel_foldl {α : Type u} {β : Type v} {γ : Type w} {δ : Type z} {r : α → β → Prop}
    {p : γ → δ → Prop} : relator.lift_fun (p ⇒ r ⇒ p) (p ⇒ forall₂ r ⇒ p) foldl foldl :=
  sorry

theorem rel_foldr {α : Type u} {β : Type v} {γ : Type w} {δ : Type z} {r : α → β → Prop}
    {p : γ → δ → Prop} : relator.lift_fun (r ⇒ p ⇒ p) (p ⇒ forall₂ r ⇒ p) foldr foldr :=
  sorry

theorem rel_filter {α : Type u} {β : Type v} {r : α → β → Prop} {p : α → Prop} {q : β → Prop}
    [decidable_pred p] [decidable_pred q] (hpq : relator.lift_fun r Iff p q) :
    relator.lift_fun (forall₂ r) (forall₂ r) (filter p) (filter q) :=
  sorry

theorem filter_map_cons {α : Type u} {β : Type v} (f : α → Option β) (a : α) (l : List α) :
    filter_map f (a :: l) =
        option.cases_on (f a) (filter_map f l) fun (b : β) => b :: filter_map f l :=
  sorry

theorem rel_filter_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type z} {r : α → β → Prop}
    {p : γ → δ → Prop} :
    relator.lift_fun (r ⇒ option.rel p) (forall₂ r ⇒ forall₂ p) filter_map filter_map :=
  sorry

theorem rel_sum {α : Type u} {β : Type v} {r : α → β → Prop} [add_monoid α] [add_monoid β]
    (h : r 0 0) (hf : relator.lift_fun r (r ⇒ r) Add.add Add.add) :
    relator.lift_fun (forall₂ r) r sum sum :=
  rel_foldl hf h

end Mathlib


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.num.basic
import Mathlib.data.bitvec.core
import Mathlib.PostPort

universes l u_1

namespace Mathlib

/-!
# Bitwise operations using binary representation of integers

## Definitions

* bitwise operations for `pos_num` and `num`,
* `snum`, a type that represents integers as a bit string with a sign bit at the end,
* arithmetic operations for `snum`.
-/

namespace pos_num

def lor : pos_num → pos_num → pos_num :=
  sorry

def land : pos_num → pos_num → num :=
  sorry

def ldiff : pos_num → pos_num → num :=
  sorry

def lxor : pos_num → pos_num → num :=
  sorry

def test_bit : pos_num → ℕ → Bool :=
  sorry

def one_bits : pos_num → ℕ → List ℕ :=
  sorry

def shiftl (p : pos_num) : ℕ → pos_num :=
  sorry

def shiftr : pos_num → ℕ → num :=
  sorry

end pos_num

namespace num

def lor : num → num → num :=
  sorry

def land : num → num → num :=
  sorry

def ldiff : num → num → num :=
  sorry

def lxor : num → num → num :=
  sorry

def shiftl : num → ℕ → num :=
  sorry

def shiftr : num → ℕ → num :=
  sorry

def test_bit : num → ℕ → Bool :=
  sorry

def one_bits : num → List ℕ :=
  sorry

end num

/-- This is a nonzero (and "non minus one") version of `snum`.
    See the documentation of `snum` for more details. -/
inductive nzsnum
where
| msb : Bool → nzsnum
| bit : Bool → nzsnum → nzsnum

/-- Alternative representation of integers using a sign bit at the end.
  The convention on sign here is to have the argument to `msb` denote
  the sign of the MSB itself, with all higher bits set to the negation
  of this sign. The result is interpreted in two's complement.

     13  = ..0001101(base 2) = nz (bit1 (bit0 (bit1 (msb tt))))
     -13 = ..1110011(base 2) = nz (bit1 (bit1 (bit0 (msb ff))))

  As with `num`, a special case must be added for zero, which has no msb,
  but by two's complement symmetry there is a second special case for -1.
  Here the `bool` field indicates the sign of the number.

     0  = ..0000000(base 2) = zero ff
     -1 = ..1111111(base 2) = zero tt -/
inductive snum
where
| zero : Bool → snum
| nz : nzsnum → snum

protected instance snum.has_coe : has_coe nzsnum snum :=
  has_coe.mk snum.nz

protected instance snum.has_zero : HasZero snum :=
  { zero := snum.zero false }

protected instance nzsnum.has_one : HasOne nzsnum :=
  { one := nzsnum.msb tt }

protected instance snum.has_one : HasOne snum :=
  { one := snum.nz 1 }

protected instance nzsnum.inhabited : Inhabited nzsnum :=
  { default := 1 }

protected instance snum.inhabited : Inhabited snum :=
  { default := 0 }

infixr:67 " :: " => Mathlib.nzsnum.bit

/-!
The `snum` representation uses a bit string, essentially a list of 0 (`ff`) and 1 (`tt`) bits,
and the negation of the MSB is sign-extended to all higher bits.
-/

namespace nzsnum

def sign : nzsnum → Bool :=
  sorry

def not : nzsnum → nzsnum :=
  sorry

prefix:40 "~" => Mathlib.nzsnum.not

def bit0 : nzsnum → nzsnum :=
  bit false

def bit1 : nzsnum → nzsnum :=
  bit tt

def head : nzsnum → Bool :=
  sorry

def tail : nzsnum → snum :=
  sorry

end nzsnum

namespace snum

def sign : snum → Bool :=
  sorry

def not : snum → snum :=
  sorry

prefix:40 "~" => Mathlib.snum.not

def bit : Bool → snum → snum :=
  sorry

infixr:67 " :: " => Mathlib.snum.bit

def bit0 : snum → snum :=
  bit false

def bit1 : snum → snum :=
  bit tt

theorem bit_zero (b : Bool) : b :: zero b = zero b :=
  bool.cases_on b (Eq.refl (false :: zero false)) (Eq.refl (tt :: zero tt))

theorem bit_one (b : Bool) : b :: zero (!b) = ↑(nzsnum.msb b) :=
  bool.cases_on b (Eq.refl (false :: zero (!false))) (Eq.refl (tt :: zero (!tt)))

end snum

namespace nzsnum

def drec' {C : snum → Sort u_1} (z : (b : Bool) → C (snum.zero b)) (s : (b : Bool) → (p : snum) → C p → C (b :: p)) (p : nzsnum) : C ↑p :=
  sorry

end nzsnum

namespace snum

def head : snum → Bool :=
  sorry

def tail : snum → snum :=
  sorry

def drec' {C : snum → Sort u_1} (z : (b : Bool) → C (zero b)) (s : (b : Bool) → (p : snum) → C p → C (b :: p)) (p : snum) : C p :=
  sorry

def rec' {α : Sort u_1} (z : Bool → α) (s : Bool → snum → α → α) : snum → α :=
  drec' z s

def test_bit : ℕ → snum → Bool :=
  sorry

def succ : snum → snum :=
  rec' (fun (b : Bool) => cond b 0 1) fun (b : Bool) (p succp : snum) => cond b (false :: succp) (tt :: p)

def pred : snum → snum :=
  rec' (fun (b : Bool) => cond b (~1) (~0)) fun (b : Bool) (p predp : snum) => cond b (false :: p) (tt :: predp)

protected def neg (n : snum) : snum :=
  succ (~n)

protected instance has_neg : Neg snum :=
  { neg := snum.neg }

def czadd : Bool → Bool → snum → snum :=
  sorry

end snum

namespace snum

/-- `a.bits n` is the vector of the `n` first bits of `a` (starting from the LSB). -/
def bits : snum → (n : ℕ) → vector Bool n :=
  sorry

def cadd : snum → snum → Bool → snum :=
  rec' (fun (a : Bool) (p : snum) (c : Bool) => czadd c a p)
    fun (a : Bool) (p : snum) (IH : snum → Bool → snum) =>
      rec' (fun (b c : Bool) => czadd c b (a :: p))
        fun (b : Bool) (q : snum) (_x : Bool → snum) (c : Bool) => bitvec.xor3 a b c :: IH q (bitvec.carry a b c)

/-- Add two `snum`s. -/
protected def add (a : snum) (b : snum) : snum :=
  cadd a b false

protected instance has_add : Add snum :=
  { add := snum.add }

/-- Substract two `snum`s. -/
protected def sub (a : snum) (b : snum) : snum :=
  a + -b

protected instance has_sub : Sub snum :=
  { sub := snum.sub }

/-- Multiply two `snum`s. -/
protected def mul (a : snum) : snum → snum :=
  rec' (fun (b : Bool) => cond b (-a) 0) fun (b : Bool) (q IH : snum) => cond b (bit0 IH + a) (bit0 IH)

protected instance has_mul : Mul snum :=
  { mul := snum.mul }


/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston, Bryan Gin-ge Chen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.galois_connection
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Equivalence relations

This file defines the complete lattice of equivalence relations on a type, results about the
inductively defined equivalence closure of a binary relation, and the analogues of some isomorphism
theorems for quotients of arbitrary types.

## Implementation notes

The function `rel` and lemmas ending in ' make it easier to talk about different
equivalence relations on the same type.

The complete lattice instance for equivalence relations could have been defined by lifting
the Galois insertion of equivalence relations on α into binary relations on α, and then using
`complete_lattice.copy` to define a complete lattice instance with more appropriate
definitional equalities (a similar example is `filter.complete_lattice` in
`order/filter/basic.lean`). This does not save space, however, and is less clear.

Partitions are not defined as a separate structure here; users are encouraged to
reason about them using the existing `setoid` and its infrastructure.

## Tags

setoid, equivalence, iseqv, relation, equivalence relation
-/

/-- A version of `setoid.r` that takes the equivalence relation as an explicit argument. -/
def setoid.rel {α : Type u_1} (r : setoid α) : α → α → Prop :=
  setoid.r

/-- A version of `quotient.eq'` compatible with `setoid.rel`, to make rewriting possible. -/
theorem quotient.eq_rel {α : Type u_1} {r : setoid α} {x : α} {y : α} : quotient.mk x = quotient.mk y ↔ setoid.rel r x y :=
  quotient.eq'

namespace setoid

theorem ext' {α : Type u_1} {r : setoid α} {s : setoid α} (H : ∀ (a b : α), rel r a b ↔ rel s a b) : r = s :=
  ext H

theorem ext_iff {α : Type u_1} {r : setoid α} {s : setoid α} : r = s ↔ ∀ (a b : α), rel r a b ↔ rel s a b :=
  { mp := fun (h : r = s) (a b : α) => h ▸ iff.rfl, mpr := ext' }

/-- Two equivalence relations are equal iff their underlying binary operations are equal. -/
theorem eq_iff_rel_eq {α : Type u_1} {r₁ : setoid α} {r₂ : setoid α} : r₁ = r₂ ↔ rel r₁ = rel r₂ :=
  { mp := fun (h : r₁ = r₂) => h ▸ rfl, mpr := fun (h : rel r₁ = rel r₂) => ext' fun (x y : α) => h ▸ iff.rfl }

/-- Defining `≤` for equivalence relations. -/
protected instance has_le {α : Type u_1} : HasLessEq (setoid α) :=
  { LessEq := fun (r s : setoid α) => ∀ {x y : α}, rel r x y → rel s x y }

theorem le_def {α : Type u_1} {r : setoid α} {s : setoid α} : r ≤ s ↔ ∀ {x y : α}, rel r x y → rel s x y :=
  iff.rfl

theorem refl' {α : Type u_1} (r : setoid α) (x : α) : rel r x x :=
  and.left iseqv x

theorem symm' {α : Type u_1} (r : setoid α) {x : α} {y : α} : rel r x y → rel r y x :=
  fun (h : rel r _x✝ _x) => and.left (and.right iseqv) _x✝ _x h

theorem trans' {α : Type u_1} (r : setoid α) {x : α} {y : α} {z : α} : rel r x y → rel r y z → rel r x z :=
  fun (hx : rel r _x✝¹ _x✝) => and.right (and.right iseqv) _x✝¹ _x✝ _x hx

/-- The kernel of a function is an equivalence relation. -/
def ker {α : Type u_1} {β : Type u_2} (f : α → β) : setoid α :=
  mk (fun (x y : α) => f x = f y) sorry

/-- The kernel of the quotient map induced by an equivalence relation r equals r. -/
@[simp] theorem ker_mk_eq {α : Type u_1} (r : setoid α) : ker quotient.mk = r :=
  ext' fun (x y : α) => quotient.eq

theorem ker_def {α : Type u_1} {β : Type u_2} {f : α → β} {x : α} {y : α} : rel (ker f) x y ↔ f x = f y :=
  iff.rfl

/-- Given types `α`, `β`, the product of two equivalence relations `r` on `α` and `s` on `β`:
    `(x₁, x₂), (y₁, y₂) ∈ α × β` are related by `r.prod s` iff `x₁` is related to `y₁`
    by `r` and `x₂` is related to `y₂` by `s`. -/
protected def prod {α : Type u_1} {β : Type u_2} (r : setoid α) (s : setoid β) : setoid (α × β) :=
  mk (fun (x y : α × β) => rel r (prod.fst x) (prod.fst y) ∧ rel s (prod.snd x) (prod.snd y)) sorry

/-- The infimum of two equivalence relations. -/
protected instance has_inf {α : Type u_1} : has_inf (setoid α) :=
  has_inf.mk fun (r s : setoid α) => mk (fun (x y : α) => rel r x y ∧ rel s x y) sorry

/-- The infimum of 2 equivalence relations r and s is the same relation as the infimum
    of the underlying binary operations. -/
theorem inf_def {α : Type u_1} {r : setoid α} {s : setoid α} : rel (r ⊓ s) = rel r ⊓ rel s :=
  rfl

theorem inf_iff_and {α : Type u_1} {r : setoid α} {s : setoid α} {x : α} {y : α} : rel (r ⊓ s) x y ↔ rel r x y ∧ rel s x y :=
  iff.rfl

/-- The infimum of a set of equivalence relations. -/
protected instance has_Inf {α : Type u_1} : has_Inf (setoid α) :=
  has_Inf.mk fun (S : set (setoid α)) => mk (fun (x y : α) => ∀ (r : setoid α), r ∈ S → rel r x y) sorry

/-- The underlying binary operation of the infimum of a set of equivalence relations
    is the infimum of the set's image under the map to the underlying binary operation. -/
theorem Inf_def {α : Type u_1} {s : set (setoid α)} : rel (Inf s) = Inf (rel '' s) := sorry

protected instance partial_order {α : Type u_1} : partial_order (setoid α) :=
  partial_order.mk LessEq (fun (r s : setoid α) => r ≤ s ∧ ¬s ≤ r) sorry sorry sorry

/-- The complete lattice of equivalence relations on a type, with bottom element `=`
    and top element the trivial equivalence relation. -/
protected instance complete_lattice {α : Type u_1} : complete_lattice (setoid α) :=
  complete_lattice.mk complete_lattice.sup complete_lattice.le complete_lattice.lt sorry sorry sorry sorry sorry sorry
    has_inf.inf sorry sorry sorry (mk (fun (_x _x : α) => True) sorry) sorry (mk Eq sorry) sorry complete_lattice.Sup
    complete_lattice.Inf sorry sorry sorry sorry

/-- The inductively defined equivalence closure of a binary relation r is the infimum
    of the set of all equivalence relations containing r. -/
theorem eqv_gen_eq {α : Type u_1} (r : α → α → Prop) : eqv_gen.setoid r = Inf (set_of fun (s : setoid α) => ∀ {x y : α}, r x y → rel s x y) := sorry

/-- The supremum of two equivalence relations r and s is the equivalence closure of the binary
    relation `x is related to y by r or s`. -/
theorem sup_eq_eqv_gen {α : Type u_1} (r : setoid α) (s : setoid α) : r ⊔ s = eqv_gen.setoid fun (x y : α) => rel r x y ∨ rel s x y := sorry

/-- The supremum of 2 equivalence relations r and s is the equivalence closure of the
    supremum of the underlying binary operations. -/
theorem sup_def {α : Type u_1} {r : setoid α} {s : setoid α} : r ⊔ s = eqv_gen.setoid (rel r ⊔ rel s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (r ⊔ s = eqv_gen.setoid (rel r ⊔ rel s))) (sup_eq_eqv_gen r s)))
    (Eq.refl (eqv_gen.setoid fun (x y : α) => rel r x y ∨ rel s x y))

/-- The supremum of a set S of equivalence relations is the equivalence closure of the binary
    relation `there exists r ∈ S relating x and y`. -/
theorem Sup_eq_eqv_gen {α : Type u_1} (S : set (setoid α)) : Sup S = eqv_gen.setoid fun (x y : α) => ∃ (r : setoid α), r ∈ S ∧ rel r x y := sorry

/-- The supremum of a set of equivalence relations is the equivalence closure of the
    supremum of the set's image under the map to the underlying binary operation. -/
theorem Sup_def {α : Type u_1} {s : set (setoid α)} : Sup s = eqv_gen.setoid (Sup (rel '' s)) := sorry

/-- The equivalence closure of an equivalence relation r is r. -/
@[simp] theorem eqv_gen_of_setoid {α : Type u_1} (r : setoid α) : eqv_gen.setoid r = r :=
  le_antisymm (eq.mpr (id (Eq._oldrec (Eq.refl (eqv_gen.setoid r ≤ r)) (eqv_gen_eq r))) (Inf_le fun (_x _x_1 : α) => id))
    eqv_gen.rel

/-- Equivalence closure is idempotent. -/
@[simp] theorem eqv_gen_idem {α : Type u_1} (r : α → α → Prop) : eqv_gen.setoid (rel (eqv_gen.setoid r)) = eqv_gen.setoid r :=
  eqv_gen_of_setoid (eqv_gen.setoid r)

/-- The equivalence closure of a binary relation r is contained in any equivalence
    relation containing r. -/
theorem eqv_gen_le {α : Type u_1} {r : α → α → Prop} {s : setoid α} (h : ∀ (x y : α), r x y → rel s x y) : eqv_gen.setoid r ≤ s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eqv_gen.setoid r ≤ s)) (eqv_gen_eq r))) (Inf_le h)

/-- Equivalence closure of binary relations is monotonic. -/
theorem eqv_gen_mono {α : Type u_1} {r : α → α → Prop} {s : α → α → Prop} (h : ∀ (x y : α), r x y → s x y) : eqv_gen.setoid r ≤ eqv_gen.setoid s :=
  eqv_gen_le fun (_x _x_1 : α) (hr : r _x _x_1) => eqv_gen.rel _x _x_1 (h _x _x_1 hr)

/-- There is a Galois insertion of equivalence relations on α into binary relations
    on α, with equivalence closure the lower adjoint. -/
def gi {α : Type u_1} : galois_insertion eqv_gen.setoid rel :=
  galois_insertion.mk (fun (r : α → α → Prop) (h : rel (eqv_gen.setoid r) ≤ r) => eqv_gen.setoid r) sorry sorry sorry

/-- A function from α to β is injective iff its kernel is the bottom element of the complete lattice
    of equivalence relations on α. -/
theorem injective_iff_ker_bot {α : Type u_1} {β : Type u_2} (f : α → β) : function.injective f ↔ ker f = ⊥ :=
  iff.symm eq_bot_iff

/-- The elements related to x ∈ α by the kernel of f are those in the preimage of f(x) under f. -/
theorem ker_iff_mem_preimage {α : Type u_1} {β : Type u_2} {f : α → β} {x : α} {y : α} : rel (ker f) x y ↔ x ∈ f ⁻¹' singleton (f y) :=
  iff.rfl

/-- Equivalence between functions `α → β` such that `r x y → f x = f y` and functions
`quotient r → β`. -/
def lift_equiv {α : Type u_1} {β : Type u_2} (r : setoid α) : (Subtype fun (f : α → β) => r ≤ ker f) ≃ (quotient r → β) :=
  equiv.mk (fun (f : Subtype fun (f : α → β) => r ≤ ker f) => quotient.lift ↑f sorry)
    (fun (f : quotient r → β) => { val := f ∘ quotient.mk, property := sorry }) sorry sorry

/-- The uniqueness part of the universal property for quotients of an arbitrary type. -/
theorem lift_unique {α : Type u_1} {β : Type u_2} {r : setoid α} {f : α → β} (H : r ≤ ker f) (g : quotient r → β) (Hg : f = g ∘ quotient.mk) : quotient.lift f H = g := sorry

/-- Given a map f from α to β, the natural map from the quotient of α by the kernel of f is
    injective. -/
theorem ker_lift_injective {α : Type u_1} {β : Type u_2} (f : α → β) : function.injective (quotient.lift f fun (_x _x_1 : α) (h : _x ≈ _x_1) => h) := sorry

/-- Given a map f from α to β, the kernel of f is the unique equivalence relation on α whose
    induced map from the quotient of α to β is injective. -/
theorem ker_eq_lift_of_injective {α : Type u_1} {β : Type u_2} {r : setoid α} (f : α → β) (H : ∀ (x y : α), rel r x y → f x = f y) (h : function.injective (quotient.lift f H)) : ker f = r := sorry

/-- The first isomorphism theorem for sets: the quotient of α by the kernel of a function f
    bijects with f's image. -/
def quotient_ker_equiv_range {α : Type u_1} {β : Type u_2} (f : α → β) : quotient (ker f) ≃ ↥(set.range f) :=
  equiv.of_bijective (quotient.lift (fun (x : α) => { val := f x, property := set.mem_range_self x }) sorry) sorry

/-- The quotient of α by the kernel of a surjective function f bijects with f's codomain. -/
def quotient_ker_equiv_of_surjective {α : Type u_1} {β : Type u_2} (f : α → β) (hf : function.surjective f) : quotient (ker f) ≃ β :=
  equiv.trans (quotient_ker_equiv_range f) (equiv.subtype_univ_equiv hf)

/-- Given a function `f : α → β` and equivalence relation `r` on `α`, the equivalence
    closure of the relation on `f`'s image defined by '`x ≈ y` iff the elements of `f⁻¹(x)` are
    related to the elements of `f⁻¹(y)` by `r`.' -/
def map {α : Type u_1} {β : Type u_2} (r : setoid α) (f : α → β) : setoid β :=
  eqv_gen.setoid fun (x y : β) => ∃ (a : α), ∃ (b : α), f a = x ∧ f b = y ∧ rel r a b

/-- Given a surjective function f whose kernel is contained in an equivalence relation r, the
    equivalence relation on f's codomain defined by x ≈ y ↔ the elements of f⁻¹(x) are related to
    the elements of f⁻¹(y) by r. -/
def map_of_surjective {α : Type u_1} {β : Type u_2} (r : setoid α) (f : α → β) (h : ker f ≤ r) (hf : function.surjective f) : setoid β :=
  mk (fun (x y : β) => ∃ (a : α), ∃ (b : α), f a = x ∧ f b = y ∧ rel r a b) sorry

/-- A special case of the equivalence closure of an equivalence relation r equalling r. -/
theorem map_of_surjective_eq_map {α : Type u_1} {β : Type u_2} {r : setoid α} {f : α → β} (h : ker f ≤ r) (hf : function.surjective f) : map r f = map_of_surjective r f h hf := sorry

/-- Given a function `f : α → β`, an equivalence relation `r` on `β` induces an equivalence
    relation on `α` defined by '`x ≈ y` iff `f(x)` is related to `f(y)` by `r`'. -/
def comap {α : Type u_1} {β : Type u_2} (f : α → β) (r : setoid β) : setoid α :=
  mk (fun (x y : α) => rel r (f x) (f y)) sorry

/-- Given a map `f : N → M` and an equivalence relation `r` on `β`, the equivalence relation
    induced on `α` by `f` equals the kernel of `r`'s quotient map composed with `f`. -/
theorem comap_eq {α : Type u_1} {β : Type u_2} {f : α → β} {r : setoid β} : comap f r = ker (quotient.mk ∘ f) := sorry

/-- The second isomorphism theorem for sets. -/
def comap_quotient_equiv {α : Type u_1} {β : Type u_2} (f : α → β) (r : setoid β) : quotient (comap f r) ≃ ↥(set.range (quotient.mk ∘ f)) :=
  equiv.trans (quotient.congr_right sorry) (quotient_ker_equiv_range (quotient.mk ∘ f))

/-- The third isomorphism theorem for sets. -/
def quotient_quotient_equiv_quotient {α : Type u_1} (r : setoid α) (s : setoid α) (h : r ≤ s) : quotient (ker (quot.map_right h)) ≃ quotient s :=
  equiv.mk
    (fun (x : quotient (ker (quot.map_right h))) =>
      quotient.lift_on' x (fun (w : Quot fun (x y : α) => rel r x y) => quotient.lift_on' w quotient.mk sorry) sorry)
    (fun (x : quotient s) => quotient.lift_on' x (fun (w : α) => quotient.mk (quotient.mk w)) sorry) sorry sorry

/-- Given an equivalence relation `r` on `α`, the order-preserving bijection between the set of
equivalence relations containing `r` and the equivalence relations on the quotient of `α` by `r`. -/
def correspondence {α : Type u_1} (r : setoid α) : (Subtype fun (s : setoid α) => r ≤ s) ≃o setoid (quotient r) :=
  rel_iso.mk
    (equiv.mk
      (fun (s : Subtype fun (s : setoid α) => r ≤ s) =>
        map_of_surjective (subtype.val s) quotient.mk sorry quotient.exists_rep)
      (fun (s : setoid (quotient r)) => { val := comap quotient.mk s, property := sorry }) sorry sorry)
    sorry


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.dfinsupp
import Mathlib.PostPort

universes v w u₁ u_1

namespace Mathlib

/-!
# Direct sum

This file defines the direct sum of abelian groups, indexed by a discrete type.

## Notation

`⨁ i, β i` is the n-ary direct sum `direct_sum`.
This notation is in the `direct_sum` locale, accessible after `open_locale direct_sum`.

## References

* https://en.wikipedia.org/wiki/Direct_sum
-/

/-- `direct_sum β` is the direct sum of a family of additive commutative monoids `β i`.

Note: `open_locale direct_sum` will enable the notation `⨁ i, β i` for `direct_sum β`. -/
def direct_sum (ι : Type v) (β : ι → Type w) [(i : ι) → add_comm_monoid (β i)] :=
  dfinsupp fun (i : ι) => β i

namespace direct_sum

protected instance add_comm_group {ι : Type v} (β : ι → Type w) [(i : ι) → add_comm_group (β i)] :
    add_comm_group (direct_sum ι β) :=
  dfinsupp.add_comm_group

@[simp] theorem sub_apply {ι : Type v} {β : ι → Type w} [(i : ι) → add_comm_group (β i)]
    (g₁ : direct_sum ι fun (i : ι) => β i) (g₂ : direct_sum ι fun (i : ι) => β i) (i : ι) :
    coe_fn (g₁ - g₂) i = coe_fn g₁ i - coe_fn g₂ i :=
  dfinsupp.sub_apply g₁ g₂ i

@[simp] theorem zero_apply {ι : Type v} (β : ι → Type w) [(i : ι) → add_comm_monoid (β i)] (i : ι) :
    coe_fn 0 i = 0 :=
  rfl

@[simp] theorem add_apply {ι : Type v} {β : ι → Type w} [(i : ι) → add_comm_monoid (β i)]
    (g₁ : direct_sum ι fun (i : ι) => β i) (g₂ : direct_sum ι fun (i : ι) => β i) (i : ι) :
    coe_fn (g₁ + g₂) i = coe_fn g₁ i + coe_fn g₂ i :=
  dfinsupp.add_apply g₁ g₂ i

/-- `mk β s x` is the element of `⨁ i, β i` that is zero outside `s`
and has coefficient `x i` for `i` in `s`. -/
def mk {ι : Type v} [dec_ι : DecidableEq ι] (β : ι → Type w) [(i : ι) → add_comm_monoid (β i)]
    (s : finset ι) : ((i : ↥↑s) → β (subtype.val i)) →+ direct_sum ι fun (i : ι) => β i :=
  add_monoid_hom.mk (dfinsupp.mk s) sorry sorry

/-- `of i` is the natural inclusion map from `β i` to `⨁ i, β i`. -/
def of {ι : Type v} [dec_ι : DecidableEq ι] (β : ι → Type w) [(i : ι) → add_comm_monoid (β i)]
    (i : ι) : β i →+ direct_sum ι fun (i : ι) => β i :=
  dfinsupp.single_add_hom β i

theorem mk_injective {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] (s : finset ι) : function.injective ⇑(mk β s) :=
  dfinsupp.mk_injective s

theorem of_injective {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] (i : ι) : function.injective ⇑(of β i) :=
  dfinsupp.single_injective

protected theorem induction_on {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {C : (direct_sum ι fun (i : ι) => β i) → Prop}
    (x : direct_sum ι fun (i : ι) => β i) (H_zero : C 0)
    (H_basic : ∀ (i : ι) (x : β i), C (coe_fn (of β i) x))
    (H_plus : ∀ (x y : direct_sum ι fun (i : ι) => β i), C x → C y → C (x + y)) : C x :=
  dfinsupp.induction x H_zero
    fun (i : ι) (b : β i) (f : dfinsupp fun (i : ι) => (fun (i : ι) => (fun (i : ι) => β i) i) i)
      (h1 : coe_fn f i = 0) (h2 : b ≠ 0) (ih : C f) =>
      H_plus (dfinsupp.single i b) f (H_basic i b) ih

/-- `to_add_monoid φ` is the natural homomorphism from `⨁ i, β i` to `γ`
induced by a family `φ` of homomorphisms `β i → γ`. -/
def to_add_monoid {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ] (φ : (i : ι) → β i →+ γ) :
    (direct_sum ι fun (i : ι) => β i) →+ γ :=
  coe_fn dfinsupp.lift_add_hom φ

@[simp] theorem to_add_monoid_of {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ] (φ : (i : ι) → β i →+ γ)
    (i : ι) (x : β i) : coe_fn (to_add_monoid φ) (coe_fn (of β i) x) = coe_fn (φ i) x :=
  dfinsupp.lift_add_hom_apply_single φ i x

theorem to_add_monoid.unique {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ]
    (ψ : (direct_sum ι fun (i : ι) => β i) →+ γ) (f : direct_sum ι fun (i : ι) => β i) :
    coe_fn ψ f = coe_fn (to_add_monoid fun (i : ι) => add_monoid_hom.comp ψ (of β i)) f :=
  sorry

/-- `from_add_monoid φ` is the natural homomorphism from `γ` to `⨁ i, β i`
induced by a family `φ` of homomorphisms `γ → β i`.

Note that this is not an isomorphism. Not every homomorphism `γ →+ ⨁ i, β i` arises in this way. -/
def from_add_monoid {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ] :
    (direct_sum ι fun (i : ι) => γ →+ β i) →+ γ →+ direct_sum ι fun (i : ι) => β i :=
  to_add_monoid fun (i : ι) => coe_fn add_monoid_hom.comp_hom (of β i)

@[simp] theorem from_add_monoid_of {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ] (i : ι) (f : γ →+ β i) :
    coe_fn from_add_monoid (coe_fn (of (fun (i : ι) => γ →+ β i) i) f) =
        add_monoid_hom.comp (of (fun (i : ι) => β i) i) f :=
  sorry

theorem from_add_monoid_of_apply {ι : Type v} [dec_ι : DecidableEq ι] {β : ι → Type w}
    [(i : ι) → add_comm_monoid (β i)] {γ : Type u₁} [add_comm_monoid γ] (i : ι) (f : γ →+ β i)
    (x : γ) :
    coe_fn (coe_fn from_add_monoid (coe_fn (of (fun (i : ι) => γ →+ β i) i) f)) x =
        coe_fn (of (fun (i : ι) => β i) i) (coe_fn f x) :=
  sorry

/-- `set_to_set β S T h` is the natural homomorphism `⨁ (i : S), β i → ⨁ (i : T), β i`,
where `h : S ⊆ T`. -/
-- TODO: generalize this to remove the assumption `S ⊆ T`.

def set_to_set {ι : Type v} [dec_ι : DecidableEq ι] (β : ι → Type w)
    [(i : ι) → add_comm_monoid (β i)] (S : set ι) (T : set ι) (H : S ⊆ T) :
    (direct_sum ↥S fun (i : ↥S) => β ↑i) →+ direct_sum ↥T fun (i : ↥T) => β ↑i :=
  to_add_monoid fun (i : ↥S) => of (fun (i : Subtype T) => β ↑i) { val := ↑i, property := sorry }

/-- The natural equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def id (M : Type v) (ι : optParam (Type u_1) PUnit) [add_comm_monoid M] [unique ι] :
    (direct_sum ι fun (_x : ι) => M) ≃+ M :=
  add_equiv.mk ⇑(to_add_monoid fun (_x : ι) => add_monoid_hom.id M)
    ⇑(of (fun (_x : ι) => M) Inhabited.default) sorry sorry sorry

end Mathlib


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
-/
import algebra.group.prod
import group_theory.group_action.defs

/-!
# Prod instances for additive and multiplicative actions

This file defines instances for binary product of additive and multiplicative actions and provides
scalar multiplication as a homomorphism from `α × β` to `β`.

## Main declarations

* `smul_mul_hom`/`smul_monoid_hom`: Scalar multiplication bundled as a multiplicative/monoid
  homomorphism.

## See also

* `group_theory.group_action.pi`
* `group_theory.group_action.sigma`
* `group_theory.group_action.sum`
-/

variables {M N P α β : Type*}

namespace prod

section

variables [has_scalar M α] [has_scalar M β] [has_scalar N α] [has_scalar N β] (a : M) (x : α × β)

@[to_additive prod.has_vadd] instance : has_scalar M (α × β) := ⟨λa p, (a • p.1, a • p.2)⟩

@[simp, to_additive] theorem smul_fst : (a • x).1 = a • x.1 := rfl
@[simp, to_additive] theorem smul_snd : (a • x).2 = a • x.2 := rfl
@[simp, to_additive] theorem smul_mk (a : M) (b : α) (c : β) : a • (b, c) = (a • b, a • c) := rfl
@[to_additive] theorem smul_def (a : M) (x : α × β) : a • x = (a • x.1, a • x.2) := rfl
@[simp, to_additive] theorem smul_swap : (a • x).swap = a • x.swap := rfl

instance [has_scalar M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
  is_scalar_tower M N (α × β) :=
⟨λ x y z, mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩

@[to_additive] instance [smul_comm_class M N α] [smul_comm_class M N β] :
  smul_comm_class M N (α × β) :=
{ smul_comm := λ r s x, mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩ }

instance [has_scalar Mᵐᵒᵖ α] [has_scalar Mᵐᵒᵖ β] [is_central_scalar M α] [is_central_scalar M β] :
  is_central_scalar M (α × β) :=
⟨λ r m, prod.ext (op_smul_eq_smul _ _) (op_smul_eq_smul _ _)⟩

@[to_additive]
instance has_faithful_smul_left [has_faithful_smul M α] [nonempty β] :
  has_faithful_smul M (α × β) :=
⟨λ x y h, let ⟨b⟩ := ‹nonempty β› in eq_of_smul_eq_smul $ λ a : α, by injection h (a, b)⟩

@[to_additive]
instance has_faithful_smul_right [nonempty α] [has_faithful_smul M β] :
  has_faithful_smul M (α × β) :=
⟨λ x y h, let ⟨a⟩ := ‹nonempty α› in eq_of_smul_eq_smul $ λ b : β, by injection h (a, b)⟩

end

@[to_additive]
instance smul_comm_class_both [has_mul N] [has_mul P] [has_scalar M N] [has_scalar M P]
  [smul_comm_class M N N] [smul_comm_class M P P] :
  smul_comm_class M (N × P) (N × P) :=
⟨λ c x y, by simp [smul_def, mul_def, mul_smul_comm]⟩

instance is_scalar_tower_both [has_mul N] [has_mul P] [has_scalar M N] [has_scalar M P]
  [is_scalar_tower M N N] [is_scalar_tower M P P] :
  is_scalar_tower M (N × P) (N × P) :=
⟨λ c x y, by simp [smul_def, mul_def, smul_mul_assoc]⟩

@[to_additive] instance {m : monoid M} [mul_action M α] [mul_action M β] : mul_action M (α × β) :=
{ mul_smul  := λ a₁ a₂ p, mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩,
  one_smul  := λ ⟨b, c⟩, mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩ }

instance {R M N : Type*} {r : monoid R} [add_monoid M] [add_monoid N]
  [distrib_mul_action R M] [distrib_mul_action R N] : distrib_mul_action R (M × N) :=
{ smul_add  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩,
  smul_zero := λ a, mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩ }

instance {R M N : Type*} {r : monoid R} [monoid M] [monoid N]
  [mul_distrib_mul_action R M] [mul_distrib_mul_action R N] : mul_distrib_mul_action R (M × N) :=
{ smul_mul  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_mul' _ _ _, smul_mul' _ _ _⟩,
  smul_one := λ a, mk.inj_iff.mpr ⟨smul_one _, smul_one _⟩ }

end prod

/-! ### Scalar multiplication as a homomorphism -/

section bundled_smul

/-- Scalar multiplication as a multiplicative homomorphism. -/
@[simps]
def smul_mul_hom [monoid α] [has_mul β] [mul_action α β] [is_scalar_tower α β β]
  [smul_comm_class α β β] :
  (α × β) →ₙ* β :=
{ to_fun := λ a, a.1 • a.2,
  map_mul' := λ a b, (smul_mul_smul _ _ _ _).symm }

/-- Scalar multiplication as a monoid homomorphism. -/
@[simps]
def smul_monoid_hom [monoid α] [mul_one_class β] [mul_action α β] [is_scalar_tower α β β]
  [smul_comm_class α β β] :
  α × β →* β :=
{ map_one' := one_smul _ _,
  .. smul_mul_hom }

end bundled_smul


import exercices_limites_suites

example
(u : ℕ → ℝ) (l : ℝ)(l' : ℝ) (H : limit u l) (H' : limit u l') :
l = l'
:=
begin
    by_contradiction,

end

example
(u : ℕ → ℝ)
(l l' : ℝ)
(H : limit u l)
(H' : limit u l')
(H1 : ¬l = l')
: false
:=
begin
  todo
end