/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Andrew Zipperer, Haitao Zhang, Minchao Wu, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.basic
import Mathlib.logic.function.conjugate
import Mathlib.PostPort

universes u v u_1 w y u_2 u_3

namespace Mathlib

/-!
# Functions over sets

## Main definitions

### Predicate

* `eq_on f₁ f₂ s` : functions `f₁` and `f₂` are equal at every point of `s`;
* `maps_to f s t` : `f` sends every point of `s` to a point of `t`;
* `inj_on f s` : restriction of `f` to `s` is injective;
* `surj_on f s t` : every point in `s` has a preimage in `s`;
* `bij_on f s t` : `f` is a bijection between `s` and `t`;
* `left_inv_on f' f s` : for every `x ∈ s` we have `f' (f x) = x`;
* `right_inv_on f' f t` : for every `y ∈ t` we have `f (f' y) = y`;
* `inv_on f' f s t` : `f'` is a two-side inverse of `f` on `s` and `t`, i.e.
  we have `left_inv_on f' f s` and `right_inv_on f' f t`.

### Functions

* `restrict f s` : restrict the domain of `f` to the set `s`;
* `cod_restrict f s h` : given `h : ∀ x, f x ∈ s`, restrict the codomain of `f` to the set `s`;
* `maps_to.restrict f s t h`: given `h : maps_to f s t`, restrict the domain of `f` to `s`
  and the codomain to `t`.
-/

namespace set

/-! ### Restrict -/

/-- Restrict domain of a function `f` to a set `s`. Same as `subtype.restrict` but this version
takes an argument `↥s` instead of `subtype s`. -/
def restrict {α : Type u} {β : Type v} (f : α → β) (s : set α) : ↥s → β := fun (x : ↥s) => f ↑x

theorem restrict_eq {α : Type u} {β : Type v} (f : α → β) (s : set α) : restrict f s = f ∘ coe :=
  rfl

@[simp] theorem restrict_apply {α : Type u} {β : Type v} (f : α → β) (s : set α) (x : ↥s) :
    restrict f s x = f ↑x :=
  rfl

@[simp] theorem range_restrict {α : Type u} {β : Type v} (f : α → β) (s : set α) :
    range (restrict f s) = f '' s :=
  Eq.trans (range_comp f fun (x : ↥s) => ↑x) (congr_arg (image f) subtype.range_coe)

/-- Restrict codomain of a function `f` to a set `s`. Same as `subtype.coind` but this version
has codomain `↥s` instead of `subtype s`. -/
def cod_restrict {α : Type u} {β : Type v} (f : α → β) (s : set β) (h : ∀ (x : α), f x ∈ s) :
    α → ↥s :=
  fun (x : α) => { val := f x, property := h x }

@[simp] theorem coe_cod_restrict_apply {α : Type u} {β : Type v} (f : α → β) (s : set β)
    (h : ∀ (x : α), f x ∈ s) (x : α) : ↑(cod_restrict f s h x) = f x :=
  rfl

/-! ### Equality on a set -/

/-- Two functions `f₁ f₂ : α → β` are equal on `s`
  if `f₁ x = f₂ x` for all `x ∈ a`. -/
def eq_on {α : Type u} {β : Type v} (f₁ : α → β) (f₂ : α → β) (s : set α) :=
  ∀ {x : α}, x ∈ s → f₁ x = f₂ x

theorem eq_on.symm {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β}
    (h : eq_on f₁ f₂ s) : eq_on f₂ f₁ s :=
  fun (x : α) (hx : x ∈ s) => Eq.symm (h hx)

theorem eq_on_comm {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β} :
    eq_on f₁ f₂ s ↔ eq_on f₂ f₁ s :=
  { mp := eq_on.symm, mpr := eq_on.symm }

theorem eq_on_refl {α : Type u} {β : Type v} (f : α → β) (s : set α) : eq_on f f s :=
  fun (_x : α) (_x_1 : _x ∈ s) => rfl

theorem eq_on.trans {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β} {f₃ : α → β}
    (h₁ : eq_on f₁ f₂ s) (h₂ : eq_on f₂ f₃ s) : eq_on f₁ f₃ s :=
  fun (x : α) (hx : x ∈ s) => Eq.trans (h₁ hx) (h₂ hx)

theorem eq_on.image_eq {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β}
    (heq : eq_on f₁ f₂ s) : f₁ '' s = f₂ '' s :=
  image_congr heq

theorem eq_on.mono {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {f₁ : α → β} {f₂ : α → β}
    (hs : s₁ ⊆ s₂) (hf : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ s₁ :=
  fun (x : α) (hx : x ∈ s₁) => hf (hs hx)

theorem comp_eq_of_eq_on_range {α : Type u} {β : Type v} {ι : Sort u_1} {f : ι → α} {g₁ : α → β}
    {g₂ : α → β} (h : eq_on g₁ g₂ (range f)) : g₁ ∘ f = g₂ ∘ f :=
  funext fun (x : ι) => h (mem_range_self x)

/-! ### maps to -/

/-- `maps_to f a b` means that the image of `a` is contained in `b`. -/
def maps_to {α : Type u} {β : Type v} (f : α → β) (s : set α) (t : set β) :=
  ∀ {x : α}, x ∈ s → f x ∈ t

/-- Given a map `f` sending `s : set α` into `t : set β`, restrict domain of `f` to `s`
and the codomain to `t`. Same as `subtype.map`. -/
def maps_to.restrict {α : Type u} {β : Type v} (f : α → β) (s : set α) (t : set β)
    (h : maps_to f s t) : ↥s → ↥t :=
  subtype.map f h

@[simp] theorem maps_to.coe_restrict_apply {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} (h : maps_to f s t) (x : ↥s) : ↑(maps_to.restrict f s t h x) = f ↑x :=
  rfl

theorem maps_to_iff_exists_map_subtype {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} : maps_to f s t ↔ ∃ (g : ↥s → ↥t), ∀ (x : ↥s), f ↑x = ↑(g x) :=
  sorry

theorem maps_to' {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β} :
    maps_to f s t ↔ f '' s ⊆ t :=
  iff.symm image_subset_iff

theorem maps_to_empty {α : Type u} {β : Type v} (f : α → β) (t : set β) : maps_to f ∅ t :=
  empty_subset fun (x : α) => t (f x)

theorem maps_to.image_subset {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : maps_to f s t) : f '' s ⊆ t :=
  iff.mp maps_to' h

theorem maps_to.congr {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β} {f₂ : α → β}
    (h₁ : maps_to f₁ s t) (h : eq_on f₁ f₂ s) : maps_to f₂ s t :=
  fun (x : α) (hx : x ∈ s) => h hx ▸ h₁ hx

theorem eq_on.maps_to_iff {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β}
    {f₂ : α → β} (H : eq_on f₁ f₂ s) : maps_to f₁ s t ↔ maps_to f₂ s t :=
  { mp := fun (h : maps_to f₁ s t) => maps_to.congr h H,
    mpr := fun (h : maps_to f₂ s t) => maps_to.congr h (eq_on.symm H) }

theorem maps_to.comp {α : Type u} {β : Type v} {γ : Type w} {s : set α} {t : set β} {p : set γ}
    {f : α → β} {g : β → γ} (h₁ : maps_to g t p) (h₂ : maps_to f s t) : maps_to (g ∘ f) s p :=
  fun (x : α) (h : x ∈ s) => h₁ (h₂ h)

theorem maps_to_id {α : Type u} (s : set α) : maps_to id s s := fun (x : α) => id

theorem maps_to.iterate {α : Type u} {f : α → α} {s : set α} (h : maps_to f s s) (n : ℕ) :
    maps_to (nat.iterate f n) s s :=
  sorry

theorem maps_to.iterate_restrict {α : Type u} {f : α → α} {s : set α} (h : maps_to f s s) (n : ℕ) :
    nat.iterate (maps_to.restrict f s s h) n =
        maps_to.restrict (nat.iterate f n) s s (maps_to.iterate h n) :=
  sorry

theorem maps_to.mono {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β} {t₂ : set β}
    {f : α → β} (hs : s₂ ⊆ s₁) (ht : t₁ ⊆ t₂) (hf : maps_to f s₁ t₁) : maps_to f s₂ t₂ :=
  fun (x : α) (hx : x ∈ s₂) => ht (hf (hs hx))

theorem maps_to.union_union {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β}
    {t₂ : set β} {f : α → β} (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
    maps_to f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
  fun (x : α) (hx : x ∈ s₁ ∪ s₂) =>
    or.elim hx (fun (hx : x ∈ s₁) => Or.inl (h₁ hx)) fun (hx : x ∈ s₂) => Or.inr (h₂ hx)

theorem maps_to.union {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t : set β} {f : α → β}
    (h₁ : maps_to f s₁ t) (h₂ : maps_to f s₂ t) : maps_to f (s₁ ∪ s₂) t :=
  union_self t ▸ maps_to.union_union h₁ h₂

@[simp] theorem maps_to_union {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t : set β}
    {f : α → β} : maps_to f (s₁ ∪ s₂) t ↔ maps_to f s₁ t ∧ maps_to f s₂ t :=
  sorry

theorem maps_to.inter {α : Type u} {β : Type v} {s : set α} {t₁ : set β} {t₂ : set β} {f : α → β}
    (h₁ : maps_to f s t₁) (h₂ : maps_to f s t₂) : maps_to f s (t₁ ∩ t₂) :=
  fun (x : α) (hx : x ∈ s) => { left := h₁ hx, right := h₂ hx }

theorem maps_to.inter_inter {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β}
    {t₂ : set β} {f : α → β} (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
    maps_to f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
  fun (x : α) (hx : x ∈ s₁ ∩ s₂) => { left := h₁ (and.left hx), right := h₂ (and.right hx) }

@[simp] theorem maps_to_inter {α : Type u} {β : Type v} {s : set α} {t₁ : set β} {t₂ : set β}
    {f : α → β} : maps_to f s (t₁ ∩ t₂) ↔ maps_to f s t₁ ∧ maps_to f s t₂ :=
  sorry

theorem maps_to_univ {α : Type u} {β : Type v} (f : α → β) (s : set α) : maps_to f s univ :=
  fun (x : α) (h : x ∈ s) => trivial

theorem maps_to_image {α : Type u} {β : Type v} (f : α → β) (s : set α) : maps_to f s (f '' s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (maps_to f s (f '' s))) (propext maps_to')))
    (subset.refl (f '' s))

theorem maps_to_preimage {α : Type u} {β : Type v} (f : α → β) (t : set β) :
    maps_to f (f ⁻¹' t) t :=
  subset.refl (f ⁻¹' t)

theorem maps_to_range {α : Type u} {β : Type v} (f : α → β) (s : set α) : maps_to f s (range f) :=
  maps_to.mono (subset.refl s) (image_subset_range f s) (maps_to_image f s)

theorem surjective_maps_to_image_restrict {α : Type u} {β : Type v} (f : α → β) (s : set α) :
    function.surjective (maps_to.restrict f s (f '' s) (maps_to_image f s)) :=
  sorry

theorem maps_to.mem_iff {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : maps_to f s t) (hc : maps_to f (sᶜ) (tᶜ)) {x : α} : f x ∈ t ↔ x ∈ s :=
  { mp := fun (ht : f x ∈ t) => by_contra fun (hs : ¬x ∈ s) => hc hs ht,
    mpr := fun (hx : x ∈ s) => h hx }

/-! ### Injectivity on a set -/

/-- `f` is injective on `a` if the restriction of `f` to `a` is injective. -/
def inj_on {α : Type u} {β : Type v} (f : α → β) (s : set α) :=
  ∀ {x₁ : α}, x₁ ∈ s → ∀ {x₂ : α}, x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂

theorem inj_on_empty {α : Type u} {β : Type v} (f : α → β) : inj_on f ∅ :=
  fun (_x : α) (h₁ : _x ∈ ∅) => false.elim h₁

theorem inj_on.eq_iff {α : Type u} {β : Type v} {s : set α} {f : α → β} {x : α} {y : α}
    (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x = f y ↔ x = y :=
  { mp := h hx hy, mpr := fun (h : x = y) => h ▸ rfl }

theorem inj_on.congr {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β}
    (h₁ : inj_on f₁ s) (h : eq_on f₁ f₂ s) : inj_on f₂ s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) => h hx ▸ h hy ▸ h₁ hx hy

theorem eq_on.inj_on_iff {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β}
    (H : eq_on f₁ f₂ s) : inj_on f₁ s ↔ inj_on f₂ s :=
  { mp := fun (h : inj_on f₁ s) => inj_on.congr h H,
    mpr := fun (h : inj_on f₂ s) => inj_on.congr h (eq_on.symm H) }

theorem inj_on.mono {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {f : α → β} (h : s₁ ⊆ s₂)
    (ht : inj_on f s₂) : inj_on f s₁ :=
  fun (x : α) (hx : x ∈ s₁) (y : α) (hy : y ∈ s₁) (H : f x = f y) => ht (h hx) (h hy) H

theorem inj_on_insert {α : Type u} {β : Type v} {f : α → β} {s : set α} {a : α} (has : ¬a ∈ s) :
    inj_on f (insert a s) ↔ inj_on f s ∧ ¬f a ∈ f '' s :=
  sorry

theorem injective_iff_inj_on_univ {α : Type u} {β : Type v} {f : α → β} :
    function.injective f ↔ inj_on f univ :=
  { mp :=
      fun (h : function.injective f) (x : α) (hx : x ∈ univ) (y : α) (hy : y ∈ univ)
        (hxy : f x = f y) => h hxy,
    mpr := fun (h : inj_on f univ) (_x _x_1 : α) (heq : f _x = f _x_1) => h trivial trivial heq }

theorem inj_on_of_injective {α : Type u} {β : Type v} {f : α → β} (h : function.injective f)
    (s : set α) : inj_on f s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : f x = f y) => h hxy

theorem Mathlib.function.injective.inj_on {α : Type u} {β : Type v} {f : α → β}
    (h : function.injective f) (s : set α) : inj_on f s :=
  inj_on_of_injective

theorem inj_on.comp {α : Type u} {β : Type v} {γ : Type w} {s : set α} {t : set β} {f : α → β}
    {g : β → γ} (hg : inj_on g t) (hf : inj_on f s) (h : maps_to f s t) : inj_on (g ∘ f) s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (heq : function.comp g f x = function.comp g f y) =>
    hf hx hy (hg (h hx) (h hy) heq)

theorem inj_on_iff_injective {α : Type u} {β : Type v} {s : set α} {f : α → β} :
    inj_on f s ↔ function.injective (restrict f s) :=
  sorry

theorem inj_on.inv_fun_on_image {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {f : α → β}
    [Nonempty α] (h : inj_on f s₂) (ht : s₁ ⊆ s₂) : function.inv_fun_on f s₂ '' (f '' s₁) = s₁ :=
  sorry

theorem inj_on_preimage {α : Type u} {β : Type v} {f : α → β} {B : set (set β)}
    (hB : B ⊆ 𝒫 range f) : inj_on (preimage f) B :=
  fun (s : set β) (hs : s ∈ B) (t : set β) (ht : t ∈ B) (hst : f ⁻¹' s = f ⁻¹' t) =>
    iff.mp (preimage_eq_preimage' (hB hs) (hB ht)) hst

/-! ### Surjectivity on a set -/

/-- `f` is surjective from `a` to `b` if `b` is contained in the image of `a`. -/
def surj_on {α : Type u} {β : Type v} (f : α → β) (s : set α) (t : set β) := t ⊆ f '' s

theorem surj_on.subset_range {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : surj_on f s t) : t ⊆ range f :=
  subset.trans h (image_subset_range f s)

theorem surj_on_iff_exists_map_subtype {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} :
    surj_on f s t ↔
        ∃ (t' : set β),
          ∃ (g : ↥s → ↥t'), t ⊆ t' ∧ function.surjective g ∧ ∀ (x : ↥s), f ↑x = ↑(g x) :=
  sorry

theorem surj_on_empty {α : Type u} {β : Type v} (f : α → β) (s : set α) : surj_on f s ∅ :=
  empty_subset (f '' s)

theorem surj_on.comap_nonempty {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : surj_on f s t) (ht : set.nonempty t) : set.nonempty s :=
  nonempty.of_image (nonempty.mono h ht)

theorem surj_on.congr {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β} {f₂ : α → β}
    (h : surj_on f₁ s t) (H : eq_on f₁ f₂ s) : surj_on f₂ s t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (surj_on f₂ s t)) (surj_on.equations._eqn_1 f₂ s t)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (t ⊆ f₂ '' s)) (Eq.symm (eq_on.image_eq H)))) h)

theorem eq_on.surj_on_iff {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β}
    {f₂ : α → β} (h : eq_on f₁ f₂ s) : surj_on f₁ s t ↔ surj_on f₂ s t :=
  { mp := fun (H : surj_on f₁ s t) => surj_on.congr H h,
    mpr := fun (H : surj_on f₂ s t) => surj_on.congr H (eq_on.symm h) }

theorem surj_on.mono {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β} {t₂ : set β}
    {f : α → β} (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) (hf : surj_on f s₁ t₂) : surj_on f s₂ t₁ :=
  subset.trans ht (subset.trans hf (image_subset f hs))

theorem surj_on.union {α : Type u} {β : Type v} {s : set α} {t₁ : set β} {t₂ : set β} {f : α → β}
    (h₁ : surj_on f s t₁) (h₂ : surj_on f s t₂) : surj_on f s (t₁ ∪ t₂) :=
  fun (x : β) (hx : x ∈ t₁ ∪ t₂) =>
    or.elim hx (fun (hx : x ∈ t₁) => h₁ hx) fun (hx : x ∈ t₂) => h₂ hx

theorem surj_on.union_union {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β}
    {t₂ : set β} {f : α → β} (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) :
    surj_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
  surj_on.union (surj_on.mono (subset_union_left s₁ s₂) (subset.refl t₁) h₁)
    (surj_on.mono (subset_union_right s₁ s₂) (subset.refl t₂) h₂)

theorem surj_on.inter_inter {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β}
    {t₂ : set β} {f : α → β} (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂)
    (h : inj_on f (s₁ ∪ s₂)) : surj_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
  sorry

theorem surj_on.inter {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t : set β} {f : α → β}
    (h₁ : surj_on f s₁ t) (h₂ : surj_on f s₂ t) (h : inj_on f (s₁ ∪ s₂)) : surj_on f (s₁ ∩ s₂) t :=
  inter_self t ▸ surj_on.inter_inter h₁ h₂ h

theorem surj_on.comp {α : Type u} {β : Type v} {γ : Type w} {s : set α} {t : set β} {p : set γ}
    {f : α → β} {g : β → γ} (hg : surj_on g t p) (hf : surj_on f s t) : surj_on (g ∘ f) s p :=
  subset.trans hg (subset.trans (image_subset g hf) (image_comp g f s ▸ subset.refl (g ∘ f '' s)))

theorem surjective_iff_surj_on_univ {α : Type u} {β : Type v} {f : α → β} :
    function.surjective f ↔ surj_on f univ univ :=
  sorry

theorem surj_on_iff_surjective {α : Type u} {β : Type v} {s : set α} {f : α → β} :
    surj_on f s univ ↔ function.surjective (restrict f s) :=
  sorry

theorem surj_on.image_eq_of_maps_to {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h₁ : surj_on f s t) (h₂ : maps_to f s t) : f '' s = t :=
  eq_of_subset_of_subset (maps_to.image_subset h₂) h₁

theorem surj_on.maps_to_compl {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : surj_on f s t) (h' : function.injective f) : maps_to f (sᶜ) (tᶜ) :=
  sorry

theorem maps_to.surj_on_compl {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : maps_to f s t) (h' : function.surjective f) : surj_on f (sᶜ) (tᶜ) :=
  iff.mpr (function.surjective.forall h')
    fun (x : α) (ht : f x ∈ (tᶜ)) => mem_image_of_mem f fun (hs : x ∈ s) => ht (h hs)

/-! ### Bijectivity -/

/-- `f` is bijective from `s` to `t` if `f` is injective on `s` and `f '' s = t`. -/
def bij_on {α : Type u} {β : Type v} (f : α → β) (s : set α) (t : set β) :=
  maps_to f s t ∧ inj_on f s ∧ surj_on f s t

theorem bij_on.maps_to {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) : maps_to f s t :=
  and.left h

theorem bij_on.inj_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) : inj_on f s :=
  and.left (and.right h)

theorem bij_on.surj_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) : surj_on f s t :=
  and.right (and.right h)

theorem bij_on.mk {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β} (h₁ : maps_to f s t)
    (h₂ : inj_on f s) (h₃ : surj_on f s t) : bij_on f s t :=
  { left := h₁, right := { left := h₂, right := h₃ } }

theorem bij_on_empty {α : Type u} {β : Type v} (f : α → β) : bij_on f ∅ ∅ :=
  { left := maps_to_empty f ∅, right := { left := inj_on_empty f, right := surj_on_empty f ∅ } }

theorem bij_on.inter {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β} {t₂ : set β}
    {f : α → β} (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
    bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
  sorry

theorem bij_on.union {α : Type u} {β : Type v} {s₁ : set α} {s₂ : set α} {t₁ : set β} {t₂ : set β}
    {f : α → β} (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
    bij_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
  { left := maps_to.union_union (bij_on.maps_to h₁) (bij_on.maps_to h₂),
    right := { left := h, right := surj_on.union_union (bij_on.surj_on h₁) (bij_on.surj_on h₂) } }

theorem bij_on.subset_range {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) : t ⊆ range f :=
  surj_on.subset_range (bij_on.surj_on h)

theorem inj_on.bij_on_image {α : Type u} {β : Type v} {s : set α} {f : α → β} (h : inj_on f s) :
    bij_on f s (f '' s) :=
  bij_on.mk (maps_to_image f s) h (subset.refl (f '' s))

theorem bij_on.congr {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β} {f₂ : α → β}
    (h₁ : bij_on f₁ s t) (h : eq_on f₁ f₂ s) : bij_on f₂ s t :=
  bij_on.mk (maps_to.congr (bij_on.maps_to h₁) h) (inj_on.congr (bij_on.inj_on h₁) h)
    (surj_on.congr (bij_on.surj_on h₁) h)

theorem eq_on.bij_on_iff {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β} {f₂ : α → β}
    (H : eq_on f₁ f₂ s) : bij_on f₁ s t ↔ bij_on f₂ s t :=
  { mp := fun (h : bij_on f₁ s t) => bij_on.congr h H,
    mpr := fun (h : bij_on f₂ s t) => bij_on.congr h (eq_on.symm H) }

theorem bij_on.image_eq {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) : f '' s = t :=
  surj_on.image_eq_of_maps_to (bij_on.surj_on h) (bij_on.maps_to h)

theorem bij_on.comp {α : Type u} {β : Type v} {γ : Type w} {s : set α} {t : set β} {p : set γ}
    {f : α → β} {g : β → γ} (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s p :=
  bij_on.mk (maps_to.comp (bij_on.maps_to hg) (bij_on.maps_to hf))
    (inj_on.comp (bij_on.inj_on hg) (bij_on.inj_on hf) (bij_on.maps_to hf))
    (surj_on.comp (bij_on.surj_on hg) (bij_on.surj_on hf))

theorem bij_on.bijective {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (h : bij_on f s t) :
    function.bijective
        (cod_restrict (restrict f s) t fun (x : ↥s) => bij_on.maps_to h (subtype.val_prop x)) :=
  sorry

theorem bijective_iff_bij_on_univ {α : Type u} {β : Type v} {f : α → β} :
    function.bijective f ↔ bij_on f univ univ :=
  sorry

theorem bij_on.compl {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    (hst : bij_on f s t) (hf : function.bijective f) : bij_on f (sᶜ) (tᶜ) :=
  sorry

/-! ### left inverse -/

/-- `g` is a left inverse to `f` on `a` means that `g (f x) = x` for all `x ∈ a`. -/
def left_inv_on {α : Type u} {β : Type v} (f' : β → α) (f : α → β) (s : set α) :=
  ∀ {x : α}, x ∈ s → f' (f x) = x

theorem left_inv_on.eq_on {α : Type u} {β : Type v} {s : set α} {f : α → β} {f' : β → α}
    (h : left_inv_on f' f s) : eq_on (f' ∘ f) id s :=
  h

theorem left_inv_on.eq {α : Type u} {β : Type v} {s : set α} {f : α → β} {f' : β → α}
    (h : left_inv_on f' f s) {x : α} (hx : x ∈ s) : f' (f x) = x :=
  h hx

theorem left_inv_on.congr_left {α : Type u} {β : Type v} {s : set α} {f : α → β} {f₁' : β → α}
    {f₂' : β → α} (h₁ : left_inv_on f₁' f s) {t : set β} (h₁' : maps_to f s t)
    (heq : eq_on f₁' f₂' t) : left_inv_on f₂' f s :=
  fun (x : α) (hx : x ∈ s) => heq (h₁' hx) ▸ h₁ hx

theorem left_inv_on.congr_right {α : Type u} {β : Type v} {s : set α} {f₁ : α → β} {f₂ : α → β}
    {f₁' : β → α} (h₁ : left_inv_on f₁' f₁ s) (heq : eq_on f₁ f₂ s) : left_inv_on f₁' f₂ s :=
  fun (x : α) (hx : x ∈ s) => heq hx ▸ h₁ hx

theorem left_inv_on.inj_on {α : Type u} {β : Type v} {s : set α} {f : α → β} {f₁' : β → α}
    (h : left_inv_on f₁' f s) : inj_on f s :=
  fun (x₁ : α) (h₁ : x₁ ∈ s) (x₂ : α) (h₂ : x₂ ∈ s) (heq : f x₁ = f x₂) =>
    Eq.trans (Eq.trans (Eq.symm (h h₁)) (congr_arg f₁' heq)) (h h₂)

theorem left_inv_on.surj_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    {f' : β → α} (h : left_inv_on f' f s) (hf : maps_to f s t) : surj_on f' t s :=
  fun (x : α) (hx : x ∈ s) => Exists.intro (f x) { left := hf hx, right := h hx }

theorem left_inv_on.maps_to {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    {f' : β → α} (h : left_inv_on f' f s) (hf : surj_on f s t) : maps_to f' t s :=
  sorry

theorem left_inv_on.comp {α : Type u} {β : Type v} {γ : Type w} {s : set α} {t : set β} {f : α → β}
    {g : β → γ} {f' : β → α} {g' : γ → β} (hf' : left_inv_on f' f s) (hg' : left_inv_on g' g t)
    (hf : maps_to f s t) : left_inv_on (f' ∘ g') (g ∘ f) s :=
  fun (x : α) (h : x ∈ s) => Eq.trans (congr_arg f' (hg' (hf h))) (hf' h)

theorem left_inv_on.mono {α : Type u} {β : Type v} {s : set α} {s₁ : set α} {f : α → β} {f' : β → α}
    (hf : left_inv_on f' f s) (ht : s₁ ⊆ s) : left_inv_on f' f s₁ :=
  fun (x : α) (hx : x ∈ s₁) => hf (ht hx)

/-! ### Right inverse -/

/-- `g` is a right inverse to `f` on `b` if `f (g x) = x` for all `x ∈ b`. -/
def right_inv_on {α : Type u} {β : Type v} (f' : β → α) (f : α → β) (t : set β) :=
  left_inv_on f f' t

theorem right_inv_on.eq_on {α : Type u} {β : Type v} {t : set β} {f : α → β} {f' : β → α}
    (h : right_inv_on f' f t) : eq_on (f ∘ f') id t :=
  h

theorem right_inv_on.eq {α : Type u} {β : Type v} {t : set β} {f : α → β} {f' : β → α}
    (h : right_inv_on f' f t) {y : β} (hy : y ∈ t) : f (f' y) = y :=
  h hy

theorem right_inv_on.congr_left {α : Type u} {β : Type v} {t : set β} {f : α → β} {f₁' : β → α}
    {f₂' : β → α} (h₁ : right_inv_on f₁' f t) (heq : eq_on f₁' f₂' t) : right_inv_on f₂' f t :=
  left_inv_on.congr_right h₁ heq

theorem right_inv_on.congr_right {α : Type u} {β : Type v} {s : set α} {t : set β} {f₁ : α → β}
    {f₂ : α → β} {f' : β → α} (h₁ : right_inv_on f' f₁ t) (hg : maps_to f' t s)
    (heq : eq_on f₁ f₂ s) : right_inv_on f' f₂ t :=
  left_inv_on.congr_left h₁ hg heq

theorem right_inv_on.surj_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    {f' : β → α} (hf : right_inv_on f' f t) (hf' : maps_to f' t s) : surj_on f s t :=
  left_inv_on.surj_on hf hf'

theorem right_inv_on.maps_to {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    {f' : β → α} (h : right_inv_on f' f t) (hf : surj_on f' t s) : maps_to f s t :=
  left_inv_on.maps_to h hf

theorem right_inv_on.comp {α : Type u} {β : Type v} {γ : Type w} {t : set β} {p : set γ} {f : α → β}
    {g : β → γ} {f' : β → α} {g' : γ → β} (hf : right_inv_on f' f t) (hg : right_inv_on g' g p)
    (g'pt : maps_to g' p t) : right_inv_on (f' ∘ g') (g ∘ f) p :=
  left_inv_on.comp hg hf g'pt

theorem right_inv_on.mono {α : Type u} {β : Type v} {t : set β} {t₁ : set β} {f : α → β}
    {f' : β → α} (hf : right_inv_on f' f t) (ht : t₁ ⊆ t) : right_inv_on f' f t₁ :=
  left_inv_on.mono hf ht

theorem inj_on.right_inv_on_of_left_inv_on {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} {f' : β → α} (hf : inj_on f s) (hf' : left_inv_on f f' t) (h₁ : maps_to f s t)
    (h₂ : maps_to f' t s) : right_inv_on f f' s :=
  fun (x : α) (h : x ∈ s) => hf (h₂ (h₁ h)) h (hf' (h₁ h))

theorem eq_on_of_left_inv_on_of_right_inv_on {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} {f₁' : β → α} {f₂' : β → α} (h₁ : left_inv_on f₁' f s) (h₂ : right_inv_on f₂' f t)
    (h : maps_to f₂' t s) : eq_on f₁' f₂' t :=
  fun (y : β) (hy : y ∈ t) => Eq.trans (congr_arg f₁' (Eq.symm (h₂ hy))) (h₁ (h hy))

theorem surj_on.left_inv_on_of_right_inv_on {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} {f' : β → α} (hf : surj_on f s t) (hf' : right_inv_on f f' s) :
    left_inv_on f f' t :=
  sorry

/-! ### Two-side inverses -/

/-- `g` is an inverse to `f` viewed as a map from `a` to `b` -/
def inv_on {α : Type u} {β : Type v} (g : β → α) (f : α → β) (s : set α) (t : set β) :=
  left_inv_on g f s ∧ right_inv_on g f t

theorem inv_on.symm {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β} {f' : β → α}
    (h : inv_on f' f s t) : inv_on f f' t s :=
  { left := and.right h, right := and.left h }

theorem inv_on.mono {α : Type u} {β : Type v} {s : set α} {s₁ : set α} {t : set β} {t₁ : set β}
    {f : α → β} {f' : β → α} (h : inv_on f' f s t) (hs : s₁ ⊆ s) (ht : t₁ ⊆ t) :
    inv_on f' f s₁ t₁ :=
  { left := left_inv_on.mono (and.left h) hs, right := right_inv_on.mono (and.right h) ht }

/-- If functions `f'` and `f` are inverse on `s` and `t`, `f` maps `s` into `t`, and `f'` maps `t`
into `s`, then `f` is a bijection between `s` and `t`. The `maps_to` arguments can be deduced from
`surj_on` statements using `left_inv_on.maps_to` and `right_inv_on.maps_to`. -/
theorem inv_on.bij_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β} {f' : β → α}
    (h : inv_on f' f s t) (hf : maps_to f s t) (hf' : maps_to f' t s) : bij_on f s t :=
  { left := hf,
    right :=
      { left := left_inv_on.inj_on (and.left h), right := right_inv_on.surj_on (and.right h) hf' } }

/-! ### `inv_fun_on` is a left/right inverse -/

theorem inj_on.left_inv_on_inv_fun_on {α : Type u} {β : Type v} {s : set α} {f : α → β} [Nonempty α]
    (h : inj_on f s) : left_inv_on (function.inv_fun_on f s) f s :=
  fun (x : α) (hx : x ∈ s) => function.inv_fun_on_eq' h hx

theorem surj_on.right_inv_on_inv_fun_on {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} [Nonempty α] (h : surj_on f s t) : right_inv_on (function.inv_fun_on f s) f t :=
  fun (y : β) (hy : y ∈ t) => function.inv_fun_on_eq (iff.mp mem_image_iff_bex (h hy))

theorem bij_on.inv_on_inv_fun_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    [Nonempty α] (h : bij_on f s t) : inv_on (function.inv_fun_on f s) f s t :=
  { left := inj_on.left_inv_on_inv_fun_on (bij_on.inj_on h),
    right := surj_on.right_inv_on_inv_fun_on (bij_on.surj_on h) }

theorem surj_on.inv_on_inv_fun_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    [Nonempty α] (h : surj_on f s t) :
    inv_on (function.inv_fun_on f s) f (function.inv_fun_on f s '' t) t :=
  sorry

theorem surj_on.maps_to_inv_fun_on {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    [Nonempty α] (h : surj_on f s t) : maps_to (function.inv_fun_on f s) t s :=
  fun (y : β) (hy : y ∈ t) =>
    iff.mpr mem_preimage (function.inv_fun_on_mem (iff.mp mem_image_iff_bex (h hy)))

theorem surj_on.bij_on_subset {α : Type u} {β : Type v} {s : set α} {t : set β} {f : α → β}
    [Nonempty α] (h : surj_on f s t) : bij_on f (function.inv_fun_on f s '' t) t :=
  sorry

theorem surj_on_iff_exists_bij_on_subset {α : Type u} {β : Type v} {s : set α} {t : set β}
    {f : α → β} : surj_on f s t ↔ ∃ (s' : set α), ∃ (H : s' ⊆ s), bij_on f s' t :=
  sorry

theorem preimage_inv_fun_of_mem {α : Type u} {β : Type v} [n : Nonempty α] {f : α → β}
    (hf : function.injective f) {s : set α} (h : Classical.choice n ∈ s) :
    function.inv_fun f ⁻¹' s = f '' s ∪ (range fᶜ) :=
  sorry

theorem preimage_inv_fun_of_not_mem {α : Type u} {β : Type v} [n : Nonempty α] {f : α → β}
    (hf : function.injective f) {s : set α} (h : ¬Classical.choice n ∈ s) :
    function.inv_fun f ⁻¹' s = f '' s :=
  sorry

end set

/-! ### Piecewise defined function -/

namespace set

@[simp] theorem piecewise_empty {α : Type u} {δ : α → Sort y} (f : (i : α) → δ i)
    (g : (i : α) → δ i) [(i : α) → Decidable (i ∈ ∅)] : piecewise ∅ f g = g :=
  sorry

@[simp] theorem piecewise_univ {α : Type u} {δ : α → Sort y} (f : (i : α) → δ i) (g : (i : α) → δ i)
    [(i : α) → Decidable (i ∈ univ)] : piecewise univ f g = f :=
  sorry

@[simp] theorem piecewise_insert_self {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    (g : (i : α) → δ i) {j : α} [(i : α) → Decidable (i ∈ insert j s)] :
    piecewise (insert j s) f g j = f j :=
  sorry

protected instance compl.decidable_mem {α : Type u} (s : set α) [(j : α) → Decidable (j ∈ s)]
    (j : α) : Decidable (j ∈ (sᶜ)) :=
  not.decidable

theorem piecewise_insert {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    (g : (i : α) → δ i) [(j : α) → Decidable (j ∈ s)] [DecidableEq α] (j : α)
    [(i : α) → Decidable (i ∈ insert j s)] :
    piecewise (insert j s) f g = function.update (piecewise s f g) j (f j) :=
  sorry

@[simp] theorem piecewise_eq_of_mem {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    (g : (i : α) → δ i) [(j : α) → Decidable (j ∈ s)] {i : α} (hi : i ∈ s) :
    piecewise s f g i = f i :=
  sorry

@[simp] theorem piecewise_eq_of_not_mem {α : Type u} {δ : α → Sort y} (s : set α)
    (f : (i : α) → δ i) (g : (i : α) → δ i) [(j : α) → Decidable (j ∈ s)] {i : α} (hi : ¬i ∈ s) :
    piecewise s f g i = g i :=
  sorry

theorem piecewise_singleton {α : Type u} {β : Type v} (x : α)
    [(y : α) → Decidable (y ∈ singleton x)] [DecidableEq α] (f : α → β) (g : α → β) :
    piecewise (singleton x) f g = function.update g x (f x) :=
  sorry

theorem piecewise_eq_on {α : Type u} {β : Type v} (s : set α) [(j : α) → Decidable (j ∈ s)]
    (f : α → β) (g : α → β) : eq_on (piecewise s f g) f s :=
  fun (_x : α) => piecewise_eq_of_mem s f g

theorem piecewise_eq_on_compl {α : Type u} {β : Type v} (s : set α) [(j : α) → Decidable (j ∈ s)]
    (f : α → β) (g : α → β) : eq_on (piecewise s f g) g (sᶜ) :=
  fun (_x : α) => piecewise_eq_of_not_mem s f g

@[simp] theorem piecewise_insert_of_ne {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    (g : (i : α) → δ i) [(j : α) → Decidable (j ∈ s)] {i : α} {j : α} (h : i ≠ j)
    [(i : α) → Decidable (i ∈ insert j s)] : piecewise (insert j s) f g i = piecewise s f g i :=
  sorry

@[simp] theorem piecewise_compl {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    (g : (i : α) → δ i) [(j : α) → Decidable (j ∈ s)] [(i : α) → Decidable (i ∈ (sᶜ))] :
    piecewise (sᶜ) f g = piecewise s g f :=
  sorry

@[simp] theorem piecewise_range_comp {α : Type u} {β : Type v} {ι : Sort u_1} (f : ι → α)
    [(j : α) → Decidable (j ∈ range f)] (g₁ : α → β) (g₂ : α → β) :
    piecewise (range f) g₁ g₂ ∘ f = g₁ ∘ f :=
  comp_eq_of_eq_on_range (piecewise_eq_on (range f) g₁ g₂)

theorem piecewise_preimage {α : Type u} {β : Type v} (s : set α) [(j : α) → Decidable (j ∈ s)]
    (f : α → β) (g : α → β) (t : set β) : piecewise s f g ⁻¹' t = s ∩ f ⁻¹' t ∪ sᶜ ∩ g ⁻¹' t :=
  sorry

theorem comp_piecewise {α : Type u} {β : Type v} {γ : Type w} (s : set α)
    [(j : α) → Decidable (j ∈ s)] (h : β → γ) {f : α → β} {g : α → β} {x : α} :
    h (piecewise s f g x) = piecewise s (h ∘ f) (h ∘ g) x :=
  sorry

@[simp] theorem piecewise_same {α : Type u} {δ : α → Sort y} (s : set α) (f : (i : α) → δ i)
    [(j : α) → Decidable (j ∈ s)] : piecewise s f f = f :=
  sorry

theorem range_piecewise {α : Type u} {β : Type v} (s : set α) [(j : α) → Decidable (j ∈ s)]
    (f : α → β) (g : α → β) : range (piecewise s f g) = f '' s ∪ g '' (sᶜ) :=
  sorry

theorem piecewise_mem_pi {α : Type u} (s : set α) [(j : α) → Decidable (j ∈ s)] {δ : α → Type u_1}
    {t : set α} {t' : (i : α) → set (δ i)} {f : (i : α) → δ i} {g : (i : α) → δ i}
    (hf : f ∈ pi t t') (hg : g ∈ pi t t') : piecewise s f g ∈ pi t t' :=
  sorry

end set

theorem strict_mono_incr_on.inj_on {α : Type u} {β : Type v} [linear_order α] [preorder β]
    {f : α → β} {s : set α} (H : strict_mono_incr_on f s) : set.inj_on f s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : f x = f y) =>
    (fun (this : ordering.compares ordering.eq x y) => this)
      (iff.mp (strict_mono_incr_on.compares H hx hy) hxy)

theorem strict_mono_decr_on.inj_on {α : Type u} {β : Type v} [linear_order α] [preorder β]
    {f : α → β} {s : set α} (H : strict_mono_decr_on f s) : set.inj_on f s :=
  strict_mono_incr_on.inj_on H

theorem strict_mono_incr_on.comp {α : Type u} {β : Type v} {γ : Type w} [preorder α] [preorder β]
    [preorder γ] {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_incr_on g t)
    (hf : strict_mono_incr_on f s) (hs : set.maps_to f s t) : strict_mono_incr_on (g ∘ f) s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : x < y) => hg (hs hx) (hs hy) (hf hx hy hxy)

theorem strict_mono.comp_strict_mono_incr_on {α : Type u} {β : Type v} {γ : Type w} [preorder α]
    [preorder β] [preorder γ] {g : β → γ} {f : α → β} {s : set α} (hg : strict_mono g)
    (hf : strict_mono_incr_on f s) : strict_mono_incr_on (g ∘ f) s :=
  fun (x : α) (hx : x ∈ s) (y : α) (hy : y ∈ s) (hxy : x < y) => hg (hf hx hy hxy)

theorem strict_mono.cod_restrict {α : Type u} {β : Type v} [preorder α] [preorder β] {f : α → β}
    (hf : strict_mono f) {s : set β} (hs : ∀ (x : α), f x ∈ s) :
    strict_mono (set.cod_restrict f s hs) :=
  hf

namespace function

theorem injective.comp_inj_on {α : Type u} {β : Type v} {γ : Type w} {f : α → β} {g : β → γ}
    {s : set α} (hg : injective g) (hf : set.inj_on f s) : set.inj_on (g ∘ f) s :=
  set.inj_on.comp (injective.inj_on hg set.univ) hf (set.maps_to_univ f s)

theorem surjective.surj_on {α : Type u} {β : Type v} {f : α → β} (hf : surjective f) (s : set β) :
    set.surj_on f set.univ s :=
  set.surj_on.mono (set.subset.refl set.univ) (set.subset_univ s)
    (iff.mp set.surjective_iff_surj_on_univ hf)

namespace semiconj

theorem maps_to_image {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β} {s : set α}
    {t : set α} (h : semiconj f fa fb) (ha : set.maps_to fa s t) :
    set.maps_to fb (f '' s) (f '' t) :=
  sorry

theorem maps_to_range {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) : set.maps_to fb (set.range f) (set.range f) :=
  sorry

theorem surj_on_image {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β} {s : set α}
    {t : set α} (h : semiconj f fa fb) (ha : set.surj_on fa s t) :
    set.surj_on fb (f '' s) (f '' t) :=
  sorry

theorem surj_on_range {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) (ha : surjective fa) : set.surj_on fb (set.range f) (set.range f) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (set.surj_on fb (set.range f) (set.range f))) (Eq.symm set.image_univ)))
    (surj_on_image h (surjective.surj_on ha set.univ))

theorem inj_on_image {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β} {s : set α}
    (h : semiconj f fa fb) (ha : set.inj_on fa s) (hf : set.inj_on f (fa '' s)) :
    set.inj_on fb (f '' s) :=
  sorry

theorem inj_on_range {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) (ha : injective fa) (hf : set.inj_on f (set.range fa)) :
    set.inj_on fb (set.range f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (set.inj_on fb (set.range f))) (Eq.symm set.image_univ)))
    (inj_on_image h (injective.inj_on ha set.univ)
      (eq.mp (Eq._oldrec (Eq.refl (set.inj_on f (set.range fa))) (Eq.symm set.image_univ)) hf))

theorem bij_on_image {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β} {s : set α}
    {t : set α} (h : semiconj f fa fb) (ha : set.bij_on fa s t) (hf : set.inj_on f t) :
    set.bij_on fb (f '' s) (f '' t) :=
  sorry

theorem bij_on_range {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) (ha : bijective fa) (hf : injective f) :
    set.bij_on fb (set.range f) (set.range f) :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (set.bij_on fb (set.range f) (set.range f))) (Eq.symm set.image_univ)))
    (bij_on_image h (iff.mp set.bijective_iff_bij_on_univ ha) (injective.inj_on hf set.univ))

theorem maps_to_preimage {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) {s : set β} {t : set β} (hb : set.maps_to fb s t) :
    set.maps_to fa (f ⁻¹' s) (f ⁻¹' t) :=
  sorry

theorem inj_on_preimage {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {f : α → β}
    (h : semiconj f fa fb) {s : set β} (hb : set.inj_on fb s) (hf : set.inj_on f (f ⁻¹' s)) :
    set.inj_on fa (f ⁻¹' s) :=
  sorry

end semiconj

theorem update_comp_eq_of_not_mem_range' {α : Sort u_1} {β : Type u_2} {γ : β → Sort u_3}
    [DecidableEq β] (g : (b : β) → γ b) {f : α → β} {i : β} (a : γ i) (h : ¬i ∈ set.range f) :
    (fun (j : α) => update g i a (f j)) = fun (j : α) => g (f j) :=
  update_comp_eq_of_forall_ne' g a fun (x : α) (hx : f x = i) => h (Exists.intro x hx)

/-- Non-dependent version of `function.update_comp_eq_of_not_mem_range'` -/
theorem update_comp_eq_of_not_mem_range {α : Sort u_1} {β : Type u_2} {γ : Sort u_3} [DecidableEq β]
    (g : β → γ) {f : α → β} {i : β} (a : γ) (h : ¬i ∈ set.range f) : update g i a ∘ f = g ∘ f :=
  update_comp_eq_of_not_mem_range' g a h

end Mathlib


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.constructions.borel_space

/-!
# Measurability criterion for ennreal-valued functions

Consider a function `f : α → ℝ≥0∞`. If the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p` and `q` are finite numbers satisfying
`p < q`, then `f` is almost-everywhere measurable. This is proved in
`ennreal.ae_measurable_of_exist_almost_disjoint_supersets`, and deduced from an analogous statement
for any target space which is a complete linear dense order, called
`measure_theory.ae_measurable_of_exist_almost_disjoint_supersets`.

Note that it should be enough to assume that the space is a conditionally complete linear order,
but the proof would be more painful. Since our only use for now is for `ℝ≥0∞`, we keep it as simple
as possible.
-/

open measure_theory set topological_space
open_locale classical ennreal nnreal

/-- If a function `f : α → β` is such that the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p < q`, then `f` is almost-everywhere
measurable. It is even enough to have this for `p` and `q` in a countable dense set. -/
theorem measure_theory.ae_measurable_of_exist_almost_disjoint_supersets
  {α : Type*} {m : measurable_space α} (μ : measure α)
  {β : Type*} [complete_linear_order β] [densely_ordered β] [topological_space β]
  [order_topology β] [second_countable_topology β] [measurable_space β] [borel_space β]
  (s : set β) (s_count : s.countable) (s_dense : dense s) (f : α → β)
  (h : ∀ (p ∈ s) (q ∈ s), p < q → ∃ u v, measurable_set u ∧ measurable_set v ∧
    {x | f x < p} ⊆ u ∧ {x | q < f x} ⊆ v ∧ μ (u ∩ v) = 0) :
  ae_measurable f μ :=
begin
  haveI : encodable s := s_count.to_encodable,
  have h' : ∀ p q, ∃ u v, measurable_set u ∧ measurable_set v ∧
    {x | f x < p} ⊆ u ∧ {x | q < f x} ⊆ v ∧ (p ∈ s → q ∈ s → p < q → μ (u ∩ v) = 0),
  { assume p q,
    by_cases H : p ∈ s ∧ q ∈ s ∧ p < q,
    { rcases h p H.1 q H.2.1 H.2.2 with ⟨u, v, hu, hv, h'u, h'v, hμ⟩,
      exact ⟨u, v, hu, hv, h'u, h'v, λ ps qs pq, hμ⟩ },
    { refine ⟨univ, univ, measurable_set.univ, measurable_set.univ, subset_univ _, subset_univ _,
        λ ps qs pq, _⟩,
      simp only [not_and] at H,
      exact (H ps qs pq).elim } },
  choose! u v huv using h',
  let u' : β → set α := λ p, ⋂ (q ∈ s ∩ Ioi p), u p q,
  have u'_meas : ∀ i, measurable_set (u' i),
  { assume i,
    exact measurable_set.bInter (s_count.mono (inter_subset_left _ _)) (λ b hb, (huv i b).1) },
  let f' : α → β := λ x, ⨅ (i : s), piecewise (u' i) (λ x, (i : β)) (λ x, (⊤ : β)) x,
  have f'_meas : measurable f',
  { apply measurable_infi,
    exact λ i, measurable.piecewise (u'_meas i) measurable_const measurable_const },
  let t := ⋃ (p : s) (q : s ∩ Ioi p), u' p ∩ v p q,
  have μt : μ t ≤ 0 := calc
    μ t ≤ ∑' (p : s) (q : s ∩ Ioi p), μ (u' p ∩ v p q) : begin
      refine (measure_Union_le _).trans _,
      apply ennreal.tsum_le_tsum (λ p, _),
      apply measure_Union_le _,
      exact (s_count.mono (inter_subset_left _ _)).to_subtype,
    end
    ... ≤ ∑' (p : s) (q : s ∩ Ioi p), μ (u p q ∩ v p q) : begin
      apply ennreal.tsum_le_tsum (λ p, _),
      refine ennreal.tsum_le_tsum (λ q, measure_mono _),
      exact inter_subset_inter_left _ (bInter_subset_of_mem q.2)
    end
    ... = ∑' (p : s) (q : s ∩ Ioi p), (0 : ℝ≥0∞) :
      by { congr, ext1 p, congr, ext1 q, exact (huv p q).2.2.2.2 p.2 q.2.1 q.2.2 }
    ... = 0 : by simp only [tsum_zero],
  have ff' : ∀ᵐ x ∂μ, f x = f' x,
  { have : ∀ᵐ x ∂μ, x ∉ t,
    { have : μ t = 0 := le_antisymm μt bot_le,
      change μ _ = 0,
      convert this,
      ext y,
      simp only [not_exists, exists_prop, mem_set_of_eq, mem_compl_iff, not_not_mem] },
    filter_upwards [this] with x hx,
    apply (infi_eq_of_forall_ge_of_forall_gt_exists_lt _ _).symm,
    { assume i,
      by_cases H : x ∈ u' i,
      swap, { simp only [H, le_top, not_false_iff, piecewise_eq_of_not_mem] },
      simp only [H, piecewise_eq_of_mem],
      contrapose! hx,
      obtain ⟨r, ⟨xr, rq⟩, rs⟩ : ∃ r, r ∈ Ioo (i : β) (f x) ∩ s :=
        dense_iff_inter_open.1 s_dense (Ioo i (f x)) is_open_Ioo (nonempty_Ioo.2 hx),
      have A : x ∈ v i r := (huv i r).2.2.2.1 rq,
      apply mem_Union.2 ⟨i, _⟩,
      refine mem_Union.2 ⟨⟨r, ⟨rs, xr⟩⟩, _⟩,
      exact ⟨H, A⟩ },
    { assume q hq,
      obtain ⟨r, ⟨xr, rq⟩, rs⟩ : ∃ r, r ∈ Ioo (f x) q ∩ s :=
        dense_iff_inter_open.1 s_dense (Ioo (f x) q) is_open_Ioo (nonempty_Ioo.2 hq),
      refine ⟨⟨r, rs⟩, _⟩,
      have A : x ∈ u' r := mem_bInter (λ i hi, (huv r i).2.2.1 xr),
      simp only [A, rq, piecewise_eq_of_mem, subtype.coe_mk] } },
  exact ⟨f', f'_meas, ff'⟩,
end

/-- If a function `f : α → ℝ≥0∞` is such that the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p` and `q` are finite numbers satisfying
`p < q`, then `f` is almost-everywhere measurable. -/
theorem ennreal.ae_measurable_of_exist_almost_disjoint_supersets
  {α : Type*} {m : measurable_space α} (μ : measure α) (f : α → ℝ≥0∞)
  (h : ∀ (p : ℝ≥0) (q : ℝ≥0), p < q → ∃ u v, measurable_set u ∧ measurable_set v ∧
    {x | f x < p} ⊆ u ∧ {x | (q : ℝ≥0∞) < f x} ⊆ v ∧ μ (u ∩ v) = 0) :
  ae_measurable f μ :=
begin
  obtain ⟨s, s_count, s_dense, s_zero, s_top⟩ : ∃ s : set ℝ≥0∞, s.countable ∧ dense s ∧
    0 ∉ s ∧ ∞ ∉ s := ennreal.exists_countable_dense_no_zero_top,
  have I : ∀ x ∈ s, x ≠ ∞ := λ x xs hx, s_top (hx ▸ xs),
  apply measure_theory.ae_measurable_of_exist_almost_disjoint_supersets μ s s_count s_dense _,
  rintros p hp q hq hpq,
  lift p to ℝ≥0 using I p hp,
  lift q to ℝ≥0 using I q hq,
  exact h p q (ennreal.coe_lt_coe.1 hpq),
end


/-
Copyright (c) 2023 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.triv_sq_zero_ext
import topology.algebra.infinite_sum.basic
import topology.algebra.module.basic

/-!
# Topology on `triv_sq_zero_ext R M`

The type `triv_sq_zero_ext R M` inherits the topology from `R × M`.

Note that this is not the topology induced by the seminorm on the dual numbers suggested by
[this Math.SE answer](https://math.stackexchange.com/a/1056378/1896), which instead induces
the topology pulled back through the projection map `triv_sq_zero_ext.fst : tsze R M → R`.
Obviously, that topology is not Hausdorff and using it would result in `exp` converging to more than
one value.

## Main results

* `triv_sq_zero_ext.topological_ring`: the ring operations are continuous

-/

variables {α S R M : Type*}

local notation `tsze` := triv_sq_zero_ext

namespace triv_sq_zero_ext
variables [topological_space R] [topological_space M]

instance : topological_space (tsze R M) :=
topological_space.induced fst ‹_› ⊓ topological_space.induced snd ‹_›

instance [t2_space R] [t2_space M] : t2_space (tsze R M) :=
prod.t2_space

lemma nhds_def (x : tsze R M) : nhds x = (nhds x.fst).prod (nhds x.snd) :=
by cases x; exact nhds_prod_eq
lemma nhds_inl [has_zero M] (x : R) : nhds (inl x : tsze R M) = (nhds x).prod (nhds 0) := nhds_def _
lemma nhds_inr [has_zero R] (m : M) : nhds (inr m : tsze R M) = (nhds 0).prod (nhds m) := nhds_def _

lemma continuous_fst : continuous (fst : tsze R M → R) := continuous_fst
lemma continuous_snd : continuous (snd : tsze R M → M) := continuous_snd

lemma continuous_inl [has_zero M] : continuous (inl : R → tsze R M) :=
continuous_id.prod_mk continuous_const
lemma continuous_inr [has_zero R] : continuous (inr : M → tsze R M) :=
continuous_const.prod_mk continuous_id

lemma embedding_inl [has_zero M] : embedding (inl : R → tsze R M) :=
embedding_of_embedding_compose continuous_inl continuous_fst embedding_id
lemma embedding_inr [has_zero R] : embedding (inr : M → tsze R M) :=
embedding_of_embedding_compose continuous_inr continuous_snd embedding_id

variables (R M)

/-- `triv_sq_zero_ext.fst` as a continuous linear map. -/
@[simps]
def fst_clm [comm_semiring R] [add_comm_monoid M] [module R M] : tsze R M →L[R] R :=
{ to_fun := fst,
  .. continuous_linear_map.fst R R M }

/-- `triv_sq_zero_ext.snd` as a continuous linear map. -/
@[simps]
def snd_clm [comm_semiring R] [add_comm_monoid M] [module R M] : tsze R M →L[R] M :=
{ to_fun := snd,
  cont := continuous_snd,
  .. continuous_linear_map.snd R R M }

/-- `triv_sq_zero_ext.inl` as a continuous linear map. -/
@[simps]
def inl_clm [comm_semiring R] [add_comm_monoid M] [module R M] : R →L[R] tsze R M :=
{ to_fun := inl,
  .. continuous_linear_map.inl R R M }

/-- `triv_sq_zero_ext.inr` as a continuous linear map. -/
@[simps]
def inr_clm [comm_semiring R] [add_comm_monoid M] [module R M] : M →L[R] tsze R M :=
{ to_fun := inr,
  .. continuous_linear_map.inr R R M }

variables {R M}

instance [has_add R] [has_add M]
  [has_continuous_add R] [has_continuous_add M] :
  has_continuous_add (tsze R M) :=
prod.has_continuous_add

instance [has_mul R] [has_add M] [has_smul R M] [has_smul Rᵐᵒᵖ M]
  [has_continuous_mul R] [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M]
  [has_continuous_add M] :
  has_continuous_mul (tsze R M) :=
⟨((continuous_fst.comp _root_.continuous_fst).mul (continuous_fst.comp _root_.continuous_snd))
  .prod_mk $
    ((continuous_fst.comp _root_.continuous_fst).smul
     (continuous_snd.comp _root_.continuous_snd)).add
    ((mul_opposite.continuous_op.comp $ continuous_fst.comp $ _root_.continuous_snd).smul
     (continuous_snd.comp _root_.continuous_fst))⟩

instance [has_neg R] [has_neg M]
  [has_continuous_neg R] [has_continuous_neg M] :
  has_continuous_neg (tsze R M) :=
prod.has_continuous_neg

/-- This is not an instance due to complaints by the `fails_quickly` linter. At any rate, we only
really care about the `topological_ring` instance below. -/
lemma topological_semiring [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M]
  [topological_semiring R] [has_continuous_add M]
  [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] :
  -- note: lean times out looking for the non_assoc_semiring instance without this hint
  @topological_semiring (tsze R M) _ (non_assoc_semiring.to_non_unital_non_assoc_semiring _) :=
{}

instance [ring R] [add_comm_group M] [module R M] [module Rᵐᵒᵖ M]
  [topological_ring R] [topological_add_group M]
  [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] :
  topological_ring (tsze R M) :=
{}

instance [has_smul S R] [has_smul S M]
  [has_continuous_const_smul S R] [has_continuous_const_smul S M] :
  has_continuous_const_smul S (tsze R M) :=
prod.has_continuous_const_smul

instance [topological_space S] [has_smul S R] [has_smul S M]
  [has_continuous_smul S R] [has_continuous_smul S M] :
  has_continuous_smul S (tsze R M) :=
prod.has_continuous_smul

variables (M)

lemma has_sum_inl [add_comm_monoid R] [add_comm_monoid M] {f : α → R} {a : R} (h : has_sum f a) :
  has_sum (λ x, inl (f x)) (inl a : tsze R M) :=
h.map (⟨inl, inl_zero _, inl_add _⟩ : R →+ tsze R M) continuous_inl

lemma has_sum_inr [add_comm_monoid R] [add_comm_monoid M] {f : α → M} {a : M} (h : has_sum f a) :
  has_sum (λ x, inr (f x)) (inr a : tsze R M) :=
h.map (⟨inr, inr_zero _, inr_add _⟩ : M →+ tsze R M) continuous_inr

lemma has_sum_fst [add_comm_monoid R] [add_comm_monoid M] {f : α → tsze R M} {a : tsze R M}
  (h : has_sum f a) : has_sum (λ x, fst (f x)) (fst a) :=
h.map (⟨fst, fst_zero, fst_add⟩ : tsze R M →+ R) continuous_fst

lemma has_sum_snd [add_comm_monoid R] [add_comm_monoid M] {f : α → tsze R M} {a : tsze R M}
  (h : has_sum f a) : has_sum (λ x, snd (f x)) (snd a) :=
h.map (⟨snd, snd_zero, snd_add⟩ : tsze R M →+ M) continuous_snd

end triv_sq_zero_ext


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.algebra.order
! leanprover-community/mathlib commit c2bcdbcbe741ed37c361a30d38e179182b989f76
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Logic
import Leanbin.Init.Classical
import Leanbin.Init.Meta.Name
import Leanbin.Init.Algebra.Classes

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option default_priority -/
/- Make sure instances defined in this file have lower priority than the ones
   defined for concrete structures -/
/- Make sure instances defined in this file have lower priority than the ones
   defined for concrete structures -/
set_option default_priority 100

universe u

variable {α : Type u}

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option auto_param.check_exists -/
set_option auto_param.check_exists false

section Preorder

/-!
### Definition of `preorder` and lemmas about types with a `preorder`
-/

#print Preorder /-
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic order_laws_tac -/
/-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
class Preorder (α : Type u) extends LE α, LT α where
  le_refl : ∀ a : α, a ≤ a
  le_trans : ∀ a b c : α, a ≤ b → b ≤ c → a ≤ c
  lt := fun a b => a ≤ b ∧ ¬b ≤ a
  lt_iff_le_not_le : ∀ a b : α, a < b ↔ a ≤ b ∧ ¬b ≤ a := by
    run_tac
      order_laws_tac
#align preorder Preorder
-/

variable [Preorder α]

#print le_refl /-
/-- The relation `≤` on a preorder is reflexive. -/
@[refl]
theorem le_refl : ∀ a : α, a ≤ a :=
  Preorder.le_refl
#align le_refl le_refl
-/

#print le_trans /-
/-- The relation `≤` on a preorder is transitive. -/
@[trans]
theorem le_trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c :=
  Preorder.le_trans
#align le_trans le_trans
-/

#print lt_iff_le_not_le /-
theorem lt_iff_le_not_le : ∀ {a b : α}, a < b ↔ a ≤ b ∧ ¬b ≤ a :=
  Preorder.lt_iff_le_not_le
#align lt_iff_le_not_le lt_iff_le_not_le
-/

#print lt_of_le_not_le /-
theorem lt_of_le_not_le : ∀ {a b : α}, a ≤ b → ¬b ≤ a → a < b
  | a, b, hab, hba => lt_iff_le_not_le.mpr ⟨hab, hba⟩
#align lt_of_le_not_le lt_of_le_not_le
-/

#print le_not_le_of_lt /-
theorem le_not_le_of_lt : ∀ {a b : α}, a < b → a ≤ b ∧ ¬b ≤ a
  | a, b, hab => lt_iff_le_not_le.mp hab
#align le_not_le_of_lt le_not_le_of_lt
-/

#print le_of_eq /-
theorem le_of_eq {a b : α} : a = b → a ≤ b := fun h => h ▸ le_refl a
#align le_of_eq le_of_eq
-/

#print ge_trans /-
@[trans]
theorem ge_trans : ∀ {a b c : α}, a ≥ b → b ≥ c → a ≥ c := fun a b c h₁ h₂ => le_trans h₂ h₁
#align ge_trans ge_trans
-/

#print lt_irrefl /-
theorem lt_irrefl : ∀ a : α, ¬a < a
  | a, haa =>
    match le_not_le_of_lt haa with
    | ⟨h1, h2⟩ => False.ndrec _ (h2 h1)
#align lt_irrefl lt_irrefl
-/

#print gt_irrefl /-
theorem gt_irrefl : ∀ a : α, ¬a > a :=
  lt_irrefl
#align gt_irrefl gt_irrefl
-/

#print lt_trans /-
@[trans]
theorem lt_trans : ∀ {a b c : α}, a < b → b < c → a < c
  | a, b, c, hab, hbc =>
    match le_not_le_of_lt hab, le_not_le_of_lt hbc with
    | ⟨hab, hba⟩, ⟨hbc, hcb⟩ => lt_of_le_not_le (le_trans hab hbc) fun hca => hcb (le_trans hca hab)
#align lt_trans lt_trans
-/

#print gt_trans /-
@[trans]
theorem gt_trans : ∀ {a b c : α}, a > b → b > c → a > c := fun a b c h₁ h₂ => lt_trans h₂ h₁
#align gt_trans gt_trans
-/

#print ne_of_lt /-
theorem ne_of_lt {a b : α} (h : a < b) : a ≠ b := fun he => absurd h (he ▸ lt_irrefl a)
#align ne_of_lt ne_of_lt
-/

#print ne_of_gt /-
theorem ne_of_gt {a b : α} (h : b < a) : a ≠ b := fun he => absurd h (he ▸ lt_irrefl a)
#align ne_of_gt ne_of_gt
-/

#print lt_asymm /-
theorem lt_asymm {a b : α} (h : a < b) : ¬b < a := fun h1 : b < a => lt_irrefl a (lt_trans h h1)
#align lt_asymm lt_asymm
-/

#print le_of_lt /-
theorem le_of_lt : ∀ {a b : α}, a < b → a ≤ b
  | a, b, hab => (le_not_le_of_lt hab).left
#align le_of_lt le_of_lt
-/

#print lt_of_lt_of_le /-
@[trans]
theorem lt_of_lt_of_le : ∀ {a b c : α}, a < b → b ≤ c → a < c
  | a, b, c, hab, hbc =>
    let ⟨hab, hba⟩ := le_not_le_of_lt hab
    lt_of_le_not_le (le_trans hab hbc) fun hca => hba (le_trans hbc hca)
#align lt_of_lt_of_le lt_of_lt_of_le
-/

#print lt_of_le_of_lt /-
@[trans]
theorem lt_of_le_of_lt : ∀ {a b c : α}, a ≤ b → b < c → a < c
  | a, b, c, hab, hbc =>
    let ⟨hbc, hcb⟩ := le_not_le_of_lt hbc
    lt_of_le_not_le (le_trans hab hbc) fun hca => hcb (le_trans hca hab)
#align lt_of_le_of_lt lt_of_le_of_lt
-/

#print gt_of_gt_of_ge /-
@[trans]
theorem gt_of_gt_of_ge {a b c : α} (h₁ : a > b) (h₂ : b ≥ c) : a > c :=
  lt_of_le_of_lt h₂ h₁
#align gt_of_gt_of_ge gt_of_gt_of_ge
-/

#print gt_of_ge_of_gt /-
@[trans]
theorem gt_of_ge_of_gt {a b c : α} (h₁ : a ≥ b) (h₂ : b > c) : a > c :=
  lt_of_lt_of_le h₂ h₁
#align gt_of_ge_of_gt gt_of_ge_of_gt
-/

#print not_le_of_gt /-
theorem not_le_of_gt {a b : α} (h : a > b) : ¬a ≤ b :=
  (le_not_le_of_lt h).right
#align not_le_of_gt not_le_of_gt
-/

#print not_lt_of_ge /-
theorem not_lt_of_ge {a b : α} (h : a ≥ b) : ¬a < b := fun hab => not_le_of_gt hab h
#align not_lt_of_ge not_lt_of_ge
-/

#print le_of_lt_or_eq /-
theorem le_of_lt_or_eq : ∀ {a b : α}, a < b ∨ a = b → a ≤ b
  | a, b, Or.inl hab => le_of_lt hab
  | a, b, Or.inr hab => hab ▸ le_refl _
#align le_of_lt_or_eq le_of_lt_or_eq
-/

#print le_of_eq_or_lt /-
theorem le_of_eq_or_lt {a b : α} (h : a = b ∨ a < b) : a ≤ b :=
  Or.elim h le_of_eq le_of_lt
#align le_of_eq_or_lt le_of_eq_or_lt
-/

/-- `<` is decidable if `≤` is. -/
def decidableLtOfDecidableLe [@DecidableRel α (· ≤ ·)] : @DecidableRel α (· < ·)
  | a, b =>
    if hab : a ≤ b then
      if hba : b ≤ a then isFalse fun hab' => not_le_of_gt hab' hba
      else isTrue <| lt_of_le_not_le hab hba
    else isFalse fun hab' => hab (le_of_lt hab')
#align decidable_lt_of_decidable_le decidableLtOfDecidableLe

end Preorder

section PartialOrder

/-!
### Definition of `partial_order` and lemmas about types with a partial order
-/

#print PartialOrder /-
/-- A partial order is a reflexive, transitive, antisymmetric relation `≤`. -/
class PartialOrder (α : Type u) extends Preorder α where
  le_antisymm : ∀ a b : α, a ≤ b → b ≤ a → a = b
#align partial_order PartialOrder
-/

variable [PartialOrder α]

#print le_antisymm /-
theorem le_antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b :=
  PartialOrder.le_antisymm
#align le_antisymm le_antisymm
-/

#print le_antisymm_iff /-
theorem le_antisymm_iff {a b : α} : a = b ↔ a ≤ b ∧ b ≤ a :=
  ⟨fun e => ⟨le_of_eq e, le_of_eq e.symm⟩, fun ⟨h1, h2⟩ => le_antisymm h1 h2⟩
#align le_antisymm_iff le_antisymm_iff
-/

#print lt_of_le_of_ne /-
theorem lt_of_le_of_ne {a b : α} : a ≤ b → a ≠ b → a < b := fun h₁ h₂ =>
  lt_of_le_not_le h₁ <| mt (le_antisymm h₁) h₂
#align lt_of_le_of_ne lt_of_le_of_ne
-/

/-- Equality is decidable if `≤` is. -/
def decidableEqOfDecidableLe [@DecidableRel α (· ≤ ·)] : DecidableEq α
  | a, b =>
    if hab : a ≤ b then
      if hba : b ≤ a then isTrue (le_antisymm hab hba) else isFalse fun heq => hba (HEq ▸ le_refl _)
    else isFalse fun heq => hab (HEq ▸ le_refl _)
#align decidable_eq_of_decidable_le decidableEqOfDecidableLe

namespace Decidable

variable [@DecidableRel α (· ≤ ·)]

#print Decidable.lt_or_eq_of_le /-
theorem lt_or_eq_of_le {a b : α} (hab : a ≤ b) : a < b ∨ a = b :=
  if hba : b ≤ a then Or.inr (le_antisymm hab hba) else Or.inl (lt_of_le_not_le hab hba)
#align decidable.lt_or_eq_of_le Decidable.lt_or_eq_of_le
-/

#print Decidable.eq_or_lt_of_le /-
theorem eq_or_lt_of_le {a b : α} (hab : a ≤ b) : a = b ∨ a < b :=
  (lt_or_eq_of_le hab).symm
#align decidable.eq_or_lt_of_le Decidable.eq_or_lt_of_le
-/

#print Decidable.le_iff_lt_or_eq /-
theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b :=
  ⟨lt_or_eq_of_le, le_of_lt_or_eq⟩
#align decidable.le_iff_lt_or_eq Decidable.le_iff_lt_or_eq
-/

end Decidable

attribute [local instance] Classical.propDecidable

#print lt_or_eq_of_le /-
theorem lt_or_eq_of_le {a b : α} : a ≤ b → a < b ∨ a = b :=
  Decidable.lt_or_eq_of_le
#align lt_or_eq_of_le lt_or_eq_of_le
-/

#print le_iff_lt_or_eq /-
theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b :=
  Decidable.le_iff_lt_or_eq
#align le_iff_lt_or_eq le_iff_lt_or_eq
-/

end PartialOrder

section LinearOrder

/-!
### Definition of `linear_order` and lemmas about types with a linear order
-/

#print maxDefault /-
/-- Default definition of `max`. -/
def maxDefault {α : Type u} [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)] (a b : α) :=
  if a ≤ b then b else a
#align max_default maxDefault
-/

#print minDefault /-
/-- Default definition of `min`. -/
def minDefault {α : Type u} [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)] (a b : α) :=
  if a ≤ b then a else b
#align min_default minDefault
-/

#print LinearOrder /-
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.interactive.reflexivity -/
/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.interactive.reflexivity -/
/-- A linear order is reflexive, transitive, antisymmetric and total relation `≤`.
We assume that every linear ordered type has decidable `(≤)`, `(<)`, and `(=)`. -/
class LinearOrder (α : Type u) extends PartialOrder α where
  le_total : ∀ a b : α, a ≤ b ∨ b ≤ a
  decidableLe : DecidableRel (· ≤ ·)
  DecidableEq : DecidableEq α := @decidableEqOfDecidableLe _ _ decidable_le
  decidableLt : DecidableRel ((· < ·) : α → α → Prop) := @decidableLtOfDecidableLe _ _ decidable_le
  max : α → α → α := @maxDefault α _ _
  max_def : max = @maxDefault α _ decidable_le := by
    run_tac
      tactic.interactive.reflexivity
  min : α → α → α := @minDefault α _ _
  min_def : min = @minDefault α _ decidable_le := by
    run_tac
      tactic.interactive.reflexivity
#align linear_order LinearOrder
-/

variable [LinearOrder α]

attribute [local instance] LinearOrder.decidableLe

#print le_total /-
theorem le_total : ∀ a b : α, a ≤ b ∨ b ≤ a :=
  LinearOrder.le_total
#align le_total le_total
-/

#print le_of_not_ge /-
theorem le_of_not_ge {a b : α} : ¬a ≥ b → a ≤ b :=
  Or.resolve_left (le_total b a)
#align le_of_not_ge le_of_not_ge
-/

#print le_of_not_le /-
theorem le_of_not_le {a b : α} : ¬a ≤ b → b ≤ a :=
  Or.resolve_left (le_total a b)
#align le_of_not_le le_of_not_le
-/

#print not_lt_of_gt /-
theorem not_lt_of_gt {a b : α} (h : a > b) : ¬a < b :=
  lt_asymm h
#align not_lt_of_gt not_lt_of_gt
-/

#print lt_trichotomy /-
theorem lt_trichotomy (a b : α) : a < b ∨ a = b ∨ b < a :=
  Or.elim (le_total a b)
    (fun h : a ≤ b =>
      Or.elim (Decidable.lt_or_eq_of_le h) (fun h : a < b => Or.inl h) fun h : a = b =>
        Or.inr (Or.inl h))
    fun h : b ≤ a =>
    Or.elim (Decidable.lt_or_eq_of_le h) (fun h : b < a => Or.inr (Or.inr h)) fun h : b = a =>
      Or.inr (Or.inl h.symm)
#align lt_trichotomy lt_trichotomy
-/

#print le_of_not_lt /-
theorem le_of_not_lt {a b : α} (h : ¬b < a) : a ≤ b :=
  match lt_trichotomy a b with
  | Or.inl hlt => le_of_lt hlt
  | Or.inr (Or.inl HEq) => HEq ▸ le_refl a
  | Or.inr (Or.inr hgt) => absurd hgt h
#align le_of_not_lt le_of_not_lt
-/

#print le_of_not_gt /-
theorem le_of_not_gt {a b : α} : ¬a > b → a ≤ b :=
  le_of_not_lt
#align le_of_not_gt le_of_not_gt
-/

#print lt_of_not_ge /-
theorem lt_of_not_ge {a b : α} (h : ¬a ≥ b) : a < b :=
  lt_of_le_not_le ((le_total _ _).resolve_right h) h
#align lt_of_not_ge lt_of_not_ge
-/

#print lt_or_le /-
theorem lt_or_le (a b : α) : a < b ∨ b ≤ a :=
  if hba : b ≤ a then Or.inr hba else Or.inl <| lt_of_not_ge hba
#align lt_or_le lt_or_le
-/

#print le_or_lt /-
theorem le_or_lt (a b : α) : a ≤ b ∨ b < a :=
  (lt_or_le b a).symm
#align le_or_lt le_or_lt
-/

#print lt_or_ge /-
theorem lt_or_ge : ∀ a b : α, a < b ∨ a ≥ b :=
  lt_or_le
#align lt_or_ge lt_or_ge
-/

#print le_or_gt /-
theorem le_or_gt : ∀ a b : α, a ≤ b ∨ a > b :=
  le_or_lt
#align le_or_gt le_or_gt
-/

#print lt_or_gt_of_ne /-
theorem lt_or_gt_of_ne {a b : α} (h : a ≠ b) : a < b ∨ a > b :=
  match lt_trichotomy a b with
  | Or.inl hlt => Or.inl hlt
  | Or.inr (Or.inl HEq) => absurd HEq h
  | Or.inr (Or.inr hgt) => Or.inr hgt
#align lt_or_gt_of_ne lt_or_gt_of_ne
-/

#print ne_iff_lt_or_gt /-
theorem ne_iff_lt_or_gt {a b : α} : a ≠ b ↔ a < b ∨ a > b :=
  ⟨lt_or_gt_of_ne, fun o => Or.elim o ne_of_lt ne_of_gt⟩
#align ne_iff_lt_or_gt ne_iff_lt_or_gt
-/

#print lt_iff_not_ge /-
theorem lt_iff_not_ge (x y : α) : x < y ↔ ¬x ≥ y :=
  ⟨not_le_of_gt, lt_of_not_ge⟩
#align lt_iff_not_ge lt_iff_not_ge
-/

#print not_lt /-
@[simp]
theorem not_lt {a b : α} : ¬a < b ↔ b ≤ a :=
  ⟨le_of_not_gt, not_lt_of_ge⟩
#align not_lt not_lt
-/

#print not_le /-
@[simp]
theorem not_le {a b : α} : ¬a ≤ b ↔ b < a :=
  (lt_iff_not_ge _ _).symm
#align not_le not_le
-/

instance (a b : α) : Decidable (a < b) :=
  LinearOrder.decidableLt a b

instance (a b : α) : Decidable (a ≤ b) :=
  LinearOrder.decidableLe a b

instance (a b : α) : Decidable (a = b) :=
  LinearOrder.decidableEq a b

#print eq_or_lt_of_not_lt /-
theorem eq_or_lt_of_not_lt {a b : α} (h : ¬a < b) : a = b ∨ b < a :=
  if h₁ : a = b then Or.inl h₁ else Or.inr (lt_of_not_ge fun hge => h (lt_of_le_of_ne hge h₁))
#align eq_or_lt_of_not_lt eq_or_lt_of_not_lt
-/

instance : IsTotalPreorder α (· ≤ ·)
    where
  trans := @le_trans _ _
  Total := le_total

-- TODO(Leo): decide whether we should keep this instance or not
instance isStrictWeakOrder_of_linearOrder : IsStrictWeakOrder α (· < ·) :=
  isStrictWeakOrder_of_isTotalPreorder lt_iff_not_ge
#align is_strict_weak_order_of_linear_order isStrictWeakOrder_of_linearOrder

-- TODO(Leo): decide whether we should keep this instance or not
instance isStrictTotalOrder_of_linearOrder : IsStrictTotalOrder α (· < ·)
    where trichotomous := lt_trichotomy
#align is_strict_total_order_of_linear_order isStrictTotalOrder_of_linearOrder

/-- Perform a case-split on the ordering of `x` and `y` in a decidable linear order. -/
def ltByCases (x y : α) {P : Sort _} (h₁ : x < y → P) (h₂ : x = y → P) (h₃ : y < x → P) : P :=
  if h : x < y then h₁ h
  else if h' : y < x then h₃ h' else h₂ (le_antisymm (le_of_not_gt h') (le_of_not_gt h))
#align lt_by_cases ltByCases

/- warning: le_imp_le_of_lt_imp_lt -> le_imp_le_of_lt_imp_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {β : Type.{u2}} [_inst_2 : Preorder.{u1} α] [_inst_3 : LinearOrder.{u2} β] {a : α} {b : α} {c : β} {d : β}, ((LT.lt.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_3))) d c) -> (LT.lt.{u1} α (Preorder.toLT.{u1} α _inst_2) b a)) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_2) a b) -> (LE.le.{u2} β (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (LinearOrder.toPartialOrder.{u2} β _inst_3))) c d)
but is expected to have type
  forall {α : Type.{u2}} {_inst_1 : Type.{u1}} [β : Preorder.{u2} α] [_inst_2 : LinearOrder.{u1} _inst_1] {_inst_3 : α} {a : α} {b : _inst_1} {c : _inst_1}, ((LT.lt.{u1} _inst_1 (Preorder.toLT.{u1} _inst_1 (PartialOrder.toPreorder.{u1} _inst_1 (LinearOrder.toPartialOrder.{u1} _inst_1 _inst_2))) c b) -> (LT.lt.{u2} α (Preorder.toLT.{u2} α β) a _inst_3)) -> (LE.le.{u2} α (Preorder.toLE.{u2} α β) _inst_3 a) -> (LE.le.{u1} _inst_1 (Preorder.toLE.{u1} _inst_1 (PartialOrder.toPreorder.{u1} _inst_1 (LinearOrder.toPartialOrder.{u1} _inst_1 _inst_2))) b c)
Case conversion may be inaccurate. Consider using '#align le_imp_le_of_lt_imp_lt le_imp_le_of_lt_imp_ltₓ'. -/
theorem le_imp_le_of_lt_imp_lt {β} [Preorder α] [LinearOrder β] {a b : α} {c d : β}
    (H : d < c → b < a) (h : a ≤ b) : c ≤ d :=
  le_of_not_lt fun h' => not_le_of_gt (H h') h
#align le_imp_le_of_lt_imp_lt le_imp_le_of_lt_imp_lt

end LinearOrder


import ProofMining.Term

inductive Formula
| equality : Term → Term → Formula
| conjunction : Formula → Formula → Formula
| disjunction : Formula → Formula → Formula
| implication : Formula → Formula → Formula
| falsum : Formula
| universal : FiniteType → Formula → Formula
| existential : FiniteType → Formula → Formula
deriving DecidableEq, Inhabited

namespace Formula

infix:100 "≅" => equality
infixl:55 " ⋀ " => conjunction
infixl:55 " ⋁ " => disjunction
infixr:50 " ⟹ " => implication
notation "∀∀" => universal
notation "∃∃" => existential

abbrev negation (A) := A ⟹ falsum

prefix:max "∼" => negation

@[appUnexpander universal] def unexpandUniversal : Lean.PrettyPrinter.Unexpander
| `(universal $ρ $A) => `(∀∀ $ρ $A)
| _ => throw ()

@[appUnexpander existential] def unexpandExistential : Lean.PrettyPrinter.Unexpander
| `(existential $ρ $A) => `(∃∃ $ρ $A)
| _ => throw ()

def shift (place : Nat) (cutoff : Nat := 0) : Formula → Formula :=
fun A => match cutoff, A with
| c, t ≅ u => t.shift place c ≅ u.shift place c
| c, A ⋀ B => A.shift place c ⋀ B.shift place c
| c, A ⋁ B => A.shift place c ⋁ B.shift place c
| c, A ⟹ B => A.shift place c ⟹ B.shift place c
| _, falsum => falsum
| c, universal ρ A => universal ρ $ A.shift place $ c + 1
| c, existential ρ A => existential ρ $ A.shift place $ c + 1

def subst : Formula → Nat → Term → Formula
| t ≅ u, i, s => t.subst i s ≅ u.subst i s
| A ⋀ B, i, s => A.subst i s ⋀ B.subst i s
| A ⋁ B, i, s => A.subst i s ⋁ B.subst i s
| A ⟹ B, i, s => A.subst i s ⟹ B.subst i s
| falsum, _, _ => falsum
| universal ρ A, i, s => universal ρ $ A.subst (i + 1) (s.shift (place := 1))
| existential ρ A, i, s => existential ρ $ A.subst (i + 1) (s.shift (place := 1))

open Term in
inductive WellFormed : Environment → Formula → Prop
| equality : WellTyped e t 0 → WellTyped e u 0 → WellFormed e (t ≅ u)
| conjunction (A B) : WellFormed e A → WellFormed e B → WellFormed e (A ⋀ B)
| disjunction (A B) : WellFormed e A → WellFormed e B → WellFormed e (A ⋁ B)
| implication (A B) : WellFormed e A → WellFormed e B → WellFormed e (A ⟹ B)
| universal (A) : WellFormed (ρ :: e) A → WellFormed e (∀∀ ρ A)
| existential (A) : WellFormed (ρ :: e) A → WellFormed e (∃∃ ρ A)
| falsum : WellFormed e falsum

notation e " ⊢ʷᶠ " A:max => WellFormed e A

def highereq : FiniteType → Term → Term → Formula
| ρ ↣ τ, s, t => universal ρ (highereq τ (Term.app (s.shift 1) $ Term.var $ 0) (Term.app (t.shift 1) $ Term.var $ 0))
| 0, s, t => equality s t

def isWellFormed (env : Environment) (A : Formula) : Bool := match env, A with
| e, t ≅ s => Term.inferType env t = some 𝕆 && Term.inferType env s = some 𝕆
| e, A ⋀ B => isWellFormed env A && isWellFormed env B
| e, A ⋁ B => isWellFormed env A && isWellFormed env B
| e, A ⟹ B => isWellFormed env A && isWellFormed env B
| e, ∀∀ σ A => isWellFormed (σ :: e) A
| e, ∃∃ σ A => isWellFormed (σ :: e) A
| _, falsum => true

#check @propext
#check @Decidable.rec
#check decide
#check Option.isSome (some 0)
#eval Option.isSome (some 0)
#print Decidable

@[simp]
theorem bool_and_iff_prop_and {x y : Bool} : (x && y) = true ↔ x = true ∧ y = true := by
  cases x <;> cases y <;> simp

#check decide

theorem well_formed_iff_is_well_formed {env} {A} : WellFormed env A ↔ isWellFormed env A := by
  apply Iff.intro
  . intros h
    induction h with
    | @equality env u v hu hv =>
      simp only [isWellFormed]
      rw [Term.infer_type_iff_well_typed] at hu hv
      simp [hu, hv]
      apply And.intro <;> exact decide_eq_true (by assumption)
    | _ => simp only [isWellFormed, *]
  . intros h
    induction A generalizing env with
    | equality a b =>
      simp only [isWellFormed, bool_and_iff_prop_and] at h
      cases h with | intro l r =>
      constructor <;> { rw [Term.infer_type_iff_well_typed]; exact of_decide_eq_true (by assumption) }
    | conjunction A B h1 h2 =>
      simp only [isWellFormed, bool_and_iff_prop_and] at h
      cases h with | intro l r =>
      have h3 := h1 l
      have h4 := h2 r
      exact WellFormed.conjunction A B h3 h4
    | disjunction A B h1 h2 =>
      simp only [isWellFormed, bool_and_iff_prop_and] at h
      cases h with | intro l r =>
      have h3 := h1 l
      have h4 := h2 r
      exact WellFormed.disjunction A B h3 h4
    | implication A B h1 h2 =>
      simp only [isWellFormed, bool_and_iff_prop_and] at h
      cases h with | intro l r =>
      have h3 := h1 l
      have h4 := h2 r
      exact WellFormed.implication A B h3 h4
    | universal ρ A h1 =>
      simp only [isWellFormed] at h
      constructor
      specialize h1 h
      exact h1
    | existential ρ A h1 =>
      simp only [isWellFormed] at h
      constructor
      specialize h1 h
      exact h1
    | falsum =>
      constructor

instance {env : Environment} {A : Formula} : Decidable $ WellFormed env A :=
  if h : isWellFormed env A
    then Decidable.isTrue (by rw [well_formed_iff_is_well_formed]; exact h)
    else Decidable.isFalse (by rw [well_formed_iff_is_well_formed]; exact h)

-- theorem subst_well_formed {env : Environment} {A : Formula} {i : Nat} {t : Term} {ρ : FiniteType} :
--   WellFormed env A → env.nth i = some ρ → Term.WellTyped env t ρ → WellFormed env (A.subst i t) := TODO_ALEX

-- theorem weakening {e₁ e₂ : Environment} {A : Formula} : List.Embedding e₁ e₂ → WellFormed e₁ A → WellFormed e₂ A := TODO_ALEX


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.option
import data.fintype.powerset
import data.fintype.sigma
import data.fintype.sum
import data.fintype.vector
import algebra.big_operators.ring
import algebra.big_operators.option

/-!
Results about "big operations" over a `fintype`, and consequent
results about cardinalities of certain types.

## Implementation note

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
This content had previously been in `data.fintype.basic`, but was moved here to avoid
requiring `algebra.big_operators` (and hence many other imports) as a
dependency of `fintype`.

However many of the results here really belong in `algebra.big_operators.basic`
and should be moved at some point.
-/

universes u v

variables {α : Type*} {β : Type*} {γ : Type*}

open_locale big_operators

namespace fintype

@[to_additive]
lemma prod_bool [comm_monoid α] (f : bool → α) : ∏ b, f b = f tt * f ff := by simp

lemma card_eq_sum_ones {α} [fintype α] : fintype.card α = ∑ a : α, 1 :=
finset.card_eq_sum_ones _

section
open finset

variables {ι : Type*} [decidable_eq ι] [fintype ι]

@[to_additive]
lemma prod_extend_by_one [comm_monoid α] (s : finset ι) (f : ι → α) :
  ∏ i, (if i ∈ s then f i else 1) = ∏ i in s, f i :=
by rw [← prod_filter, filter_mem_eq_inter, univ_inter]

end

section
variables {M : Type*} [fintype α] [comm_monoid M]

@[to_additive]
lemma prod_eq_one (f : α → M) (h : ∀ a, f a = 1) :
  (∏ a, f a) = 1 :=
finset.prod_eq_one $ λ a ha, h a

@[to_additive]
lemma prod_congr (f g : α → M) (h : ∀ a, f a = g a) :
  (∏ a, f a) = ∏ a, g a :=
finset.prod_congr rfl $ λ a ha, h a

@[to_additive]
lemma prod_eq_single {f : α → M} (a : α) (h : ∀ x ≠ a, f x = 1) :
  (∏ x, f x) = f a :=
finset.prod_eq_single a (λ x _ hx, h x hx) $ λ ha, (ha (finset.mem_univ a)).elim

@[to_additive]
lemma prod_eq_mul {f : α → M} (a b : α) (h₁ : a ≠ b) (h₂ : ∀ x, x ≠ a ∧ x ≠ b → f x = 1) :
  (∏ x, f x) = (f a) * (f b) :=
begin
  apply finset.prod_eq_mul a b h₁ (λ x _ hx, h₂ x hx);
  exact λ hc, (hc (finset.mem_univ _)).elim
end

/-- If a product of a `finset` of a subsingleton type has a given
value, so do the terms in that product. -/
@[to_additive "If a sum of a `finset` of a subsingleton type has a given
value, so do the terms in that sum."]
lemma eq_of_subsingleton_of_prod_eq {ι : Type*} [subsingleton ι] {s : finset ι}
    {f : ι → M} {b : M} (h : ∏ i in s, f i = b) : ∀ i ∈ s, f i = b :=
finset.eq_of_card_le_one_of_prod_eq (finset.card_le_one_of_subsingleton s) h

end

end fintype

open finset

section

variables {M : Type*} [fintype α] [comm_monoid M]

@[simp, to_additive]
lemma fintype.prod_option (f : option α → M) : ∏ i, f i = f none * ∏ i, f (some i) :=
finset.prod_insert_none f univ

end

open finset

@[simp] theorem fintype.card_sigma {α : Type*} (β : α → Type*)
  [fintype α] [∀ a, fintype (β a)] :
  fintype.card (sigma β) = ∑ a, fintype.card (β a) :=
card_sigma _ _

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

@[simp] lemma fintype.card_pi_finset [decidable_eq α] [fintype α]
  {δ : α → Type*} (t : Π a, finset (δ a)) :
  (fintype.pi_finset t).card = ∏ a, card (t a) :=
by simp [fintype.pi_finset, card_map]

@[simp] lemma fintype.card_pi {β : α → Type*} [decidable_eq α] [fintype α]
  [f : Π a, fintype (β a)] : fintype.card (Π a, β a) = ∏ a, fintype.card (β a) :=
fintype.card_pi_finset _

-- FIXME ouch, this should be in the main file.
@[simp] lemma fintype.card_fun [decidable_eq α] [fintype α] [fintype β] :
  fintype.card (α → β) = fintype.card β ^ fintype.card α :=
by rw [fintype.card_pi, finset.prod_const]; refl

@[simp] lemma card_vector [fintype α] (n : ℕ) :
  fintype.card (vector α n) = fintype.card α ^ n :=
by rw fintype.of_equiv_card; simp

@[simp, to_additive]
lemma finset.prod_attach_univ [fintype α] [comm_monoid β] (f : {a : α // a ∈ @univ α _} → β) :
  ∏ x in univ.attach, f x = ∏ x, f ⟨x, (mem_univ _)⟩ :=
fintype.prod_equiv (equiv.subtype_univ_equiv (λ x, mem_univ _)) _ _ (λ x, by simp)

/-- Taking a product over `univ.pi t` is the same as taking the product over `fintype.pi_finset t`.
  `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, but differ
  in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and
  `fintype.pi_finset t` is a `finset (Π a, t a)`. -/
@[to_additive "Taking a sum over `univ.pi t` is the same as taking the sum over
  `fintype.pi_finset t`. `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`,
  but differ in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and
  `fintype.pi_finset t` is a `finset (Π a, t a)`."]
lemma finset.prod_univ_pi [decidable_eq α] [fintype α] [comm_monoid β]
  {δ : α → Type*} {t : Π (a : α), finset (δ a)}
  (f : (Π (a : α), a ∈ (univ : finset α) → δ a) → β) :
  ∏ x in univ.pi t, f x = ∏ x in fintype.pi_finset t, f (λ a _, x a) :=
prod_bij (λ x _ a, x a (mem_univ _))
  (by simp)
  (by simp)
  (by simp [function.funext_iff] {contextual := tt})
  (λ x hx, ⟨λ a _, x a, by simp * at *⟩)

/-- The product over `univ` of a sum can be written as a sum over the product of sets,
  `fintype.pi_finset`. `finset.prod_sum` is an alternative statement when the product is not
  over `univ` -/
lemma finset.prod_univ_sum [decidable_eq α] [fintype α] [comm_semiring β] {δ : α → Type u_1}
  [Π (a : α), decidable_eq (δ a)] {t : Π (a : α), finset (δ a)}
  {f : Π (a : α), δ a → β} :
  ∏ a, ∑ b in t a, f a b = ∑ p in fintype.pi_finset t, ∏ x, f x (p x) :=
by simp only [finset.prod_attach_univ, prod_sum, finset.sum_univ_pi]

/-- Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a fintype of cardinality `n`
gives `(a + b)^n`. The "good" proof involves expanding along all coordinates using the fact that
`x^n` is multilinear, but multilinear maps are only available now over rings, so we give instead
a proof reducing to the usual binomial theorem to have a result over semirings. -/
lemma fintype.sum_pow_mul_eq_add_pow
  (α : Type*) [fintype α] {R : Type*} [comm_semiring R] (a b : R) :
  ∑ s : finset α, a ^ s.card * b ^ (fintype.card α - s.card) =
  (a + b) ^ (fintype.card α) :=
finset.sum_pow_mul_eq_add_pow _ _ _

@[to_additive]
lemma function.bijective.prod_comp [fintype α] [fintype β] [comm_monoid γ] {f : α → β}
  (hf : function.bijective f) (g : β → γ) :
  ∏ i, g (f i) = ∏ i, g i :=
fintype.prod_bijective f hf _ _ (λ x, rfl)

@[to_additive]
lemma equiv.prod_comp [fintype α] [fintype β] [comm_monoid γ] (e : α ≃ β) (f : β → γ) :
  ∏ i, f (e i) = ∏ i, f i :=
e.bijective.prod_comp f

@[to_additive]
lemma equiv.prod_comp' [fintype α] [fintype β] [comm_monoid γ] (e : α ≃ β) (f : α → γ) (g : β → γ)
  (h : ∀ i, f i = g (e i)) : ∏ i, f i = ∏ i, g i :=
(show f = g ∘ e, from funext h).symm ▸ e.prod_comp _

/-- It is equivalent to compute the product of a function over `fin n` or `finset.range n`. -/
@[to_additive "It is equivalent to sum a function over `fin n` or `finset.range n`."]
lemma fin.prod_univ_eq_prod_range [comm_monoid α] (f : ℕ → α) (n : ℕ) :
  ∏ i : fin n, f i = ∏ i in range n, f i :=
calc (∏ i : fin n, f i) = ∏ i : {x // x ∈ range n}, f i :
  (fin.equiv_subtype.trans (equiv.subtype_equiv_right (by simp))).prod_comp' _ _ (by simp)
... = ∏ i in range n, f i : by rw [← attach_eq_univ, prod_attach]

@[to_additive]
lemma finset.prod_fin_eq_prod_range [comm_monoid β] {n : ℕ} (c : fin n → β) :
  ∏ i, c i = ∏ i in finset.range n, if h : i < n then c ⟨i, h⟩ else 1 :=
begin
  rw [← fin.prod_univ_eq_prod_range, finset.prod_congr rfl],
  rintros ⟨i, hi⟩ _,
  simp only [fin.coe_eq_val, hi, dif_pos]
end

@[to_additive]
lemma finset.prod_to_finset_eq_subtype {M : Type*} [comm_monoid M] [fintype α]
  (p : α → Prop) [decidable_pred p] (f : α → M) :
    ∏ a in {x | p x}.to_finset, f a = ∏ a : subtype p, f a :=
by { rw ← finset.prod_subtype, simp }

@[to_additive] lemma finset.prod_fiberwise [decidable_eq β] [fintype β] [comm_monoid γ]
  (s : finset α) (f : α → β) (g : α → γ) :
  ∏ b : β, ∏ a in s.filter (λ a, f a = b), g a = ∏ a in s, g a :=
finset.prod_fiberwise_of_maps_to (λ x _, mem_univ _) _

@[to_additive]
lemma fintype.prod_fiberwise [fintype α] [decidable_eq β] [fintype β] [comm_monoid γ]
  (f : α → β) (g : α → γ) :
  (∏ b : β, ∏ a : {a // f a = b}, g (a : α)) = ∏ a, g a :=
begin
  rw [← (equiv.sigma_fiber_equiv f).prod_comp, ← univ_sigma_univ, prod_sigma],
  refl
end

lemma fintype.prod_dite [fintype α] {p : α → Prop} [decidable_pred p]
  [comm_monoid β] (f : Π (a : α) (ha : p a), β) (g : Π (a : α) (ha : ¬p a), β) :
  (∏ a, dite (p a) (f a) (g a)) = (∏ a : {a // p a}, f a a.2) * (∏ a : {a // ¬p a}, g a a.2) :=
begin
  simp only [prod_dite, attach_eq_univ],
  congr' 1,
  { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // p x}, f x x.2),
    simp },
  { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // ¬p x}, g x x.2),
    simp }
end

section
open finset

variables {α₁ : Type*} {α₂ : Type*} {M : Type*} [fintype α₁] [fintype α₂] [comm_monoid M]

@[to_additive]
lemma fintype.prod_sum_elim (f : α₁ → M) (g : α₂ → M) :
  (∏ x, sum.elim f g x) = (∏ a₁, f a₁) * (∏ a₂, g a₂) :=
prod_disj_sum _ _ _

@[simp, to_additive]
lemma fintype.prod_sum_type (f : α₁ ⊕ α₂ → M) :
  (∏ x, f x) = (∏ a₁, f (sum.inl a₁)) * (∏ a₂, f (sum.inr a₂)) :=
prod_disj_sum _ _ _

end


/-
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 data.list.basic

/-!
# Double universal quantification on a list

This file provides an API for `list.forall₂` (definition in `data.list.defs`).
`forall₂ r l₁ l₂` means that `∀ a ∈ l₁, ∀ b ∈ l₂, r a b`, where `l₁`, `l₂` are lists.
-/

open nat function

namespace list

variables {α β γ δ : Type*} {r : α → β → Prop} {p : γ → δ → Prop}
open relator

mk_iff_of_inductive_prop list.forall₂ list.forall₂_iff

@[simp] theorem forall₂_cons {R : α → β → Prop} {a b l₁ l₂} :
  forall₂ R (a :: l₁) (b :: l₂) ↔ R a b ∧ forall₂ R l₁ l₂ :=
⟨λ h, by cases h with h₁ h₂; split; assumption, λ ⟨h₁, h₂⟩, forall₂.cons h₁ h₂⟩

theorem forall₂.imp {R S : α → β → Prop}
  (H : ∀ a b, R a b → S a b) {l₁ l₂}
  (h : forall₂ R l₁ l₂) : forall₂ S l₁ l₂ :=
by induction h; constructor; solve_by_elim

lemma forall₂.mp {r q s : α → β → Prop} (h : ∀ a b, r a b → q a b → s a b) :
  ∀ {l₁ l₂}, forall₂ r l₁ l₂ → forall₂ q l₁ l₂ → forall₂ s l₁ l₂
| []        []        forall₂.nil           forall₂.nil           := forall₂.nil
| (a :: l₁) (b :: l₂) (forall₂.cons hr hrs) (forall₂.cons hq hqs) :=
  forall₂.cons (h a b hr hq) (forall₂.mp hrs hqs)

lemma forall₂.flip : ∀ {a b}, forall₂ (flip r) b a → forall₂ r a b
| _ _                 forall₂.nil          := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons h₁ h₂.flip

lemma forall₂_same {r : α → α → Prop} : ∀ {l}, (∀ x∈l, r x x) → forall₂ r l l
| []        _ := forall₂.nil
| (a :: as) h := forall₂.cons
    (h _ (mem_cons_self _ _))
    (forall₂_same $ λ a ha, h a $ mem_cons_of_mem _ ha)

lemma forall₂_refl {r} [is_refl α r] (l : list α) : forall₂ r l l :=
forall₂_same $ λ a h, is_refl.refl _

lemma forall₂_eq_eq_eq : forall₂ ((=) : α → α → Prop) = (=) :=
begin
  funext a b, apply propext,
  split,
  { intro h, induction h, {refl}, simp only [*]; split; refl },
  { intro h, subst h, exact forall₂_refl _ }
end

@[simp, priority 900] lemma forall₂_nil_left_iff {l} : forall₂ r nil l ↔ l = nil :=
⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩

@[simp, priority 900] lemma forall₂_nil_right_iff {l} : forall₂ r l nil ↔ l = nil :=
⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩

lemma forall₂_cons_left_iff {a l u} :
  forall₂ r (a :: l) u ↔ (∃b u', r a b ∧ forall₂ r l u' ∧ u = b :: u') :=
iff.intro
  (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end)
  (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end)

lemma forall₂_cons_right_iff {b l u} :
  forall₂ r u (b :: l) ↔ (∃a u', r a b ∧ forall₂ r u' l ∧ u = a :: u') :=
iff.intro
  (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end)
  (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end)

lemma forall₂_and_left {r : α → β → Prop} {p : α → Prop} :
  ∀ l u, forall₂ (λa b, p a ∧ r a b) l u ↔ (∀ a∈l, p a) ∧ forall₂ r l u
| []     u := by simp only [forall₂_nil_left_iff, forall_prop_of_false (not_mem_nil _),
    imp_true_iff, true_and]
| (a :: l) u := by simp only [forall₂_and_left l, forall₂_cons_left_iff, forall_mem_cons,
    and_assoc, and_comm, and.left_comm, exists_and_distrib_left.symm]

@[simp] lemma forall₂_map_left_iff {f : γ → α} :
  ∀ {l u}, forall₂ r (map f l) u ↔ forall₂ (λc b, r (f c) b) l u
| []     _ := by simp only [map, forall₂_nil_left_iff]
| (a :: l) _ := by simp only [map, forall₂_cons_left_iff, forall₂_map_left_iff]

@[simp] lemma forall₂_map_right_iff {f : γ → β} :
  ∀ {l u}, forall₂ r l (map f u) ↔ forall₂ (λa c, r a (f c)) l u
| _ []     := by simp only [map, forall₂_nil_right_iff]
| _ (b :: u) := by simp only [map, forall₂_cons_right_iff, forall₂_map_right_iff]

lemma left_unique_forall₂' (hr : left_unique r) :
  ∀ {a b c}, forall₂ r a c → forall₂ r b c → a = b
| a₀ nil a₁ forall₂.nil forall₂.nil := rfl
| (a₀ :: l₀) (b :: l) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) :=
  hr ha₀ ha₁ ▸ left_unique_forall₂' h₀ h₁ ▸ rfl

lemma _root_.relator.left_unique.forall₂ (hr : left_unique r) : left_unique (forall₂ r) :=
@left_unique_forall₂' _ _ _ hr

lemma right_unique_forall₂' (hr : right_unique r) : ∀ {a b c}, forall₂ r a b → forall₂ r a c → b = c
| nil a₀ a₁ forall₂.nil forall₂.nil := rfl
| (b :: l) (a₀ :: l₀) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) :=
  hr ha₀ ha₁ ▸ right_unique_forall₂' h₀ h₁ ▸ rfl

lemma _root_.relator.right_unique.forall₂ (hr : right_unique r) : right_unique (forall₂ r) :=
@right_unique_forall₂' _ _ _ hr

lemma _root_.relator.bi_unique.forall₂ (hr : bi_unique r) : bi_unique (forall₂ r) :=
⟨hr.left.forall₂, hr.right.forall₂⟩

theorem forall₂_length_eq {R : α → β → Prop} :
  ∀ {l₁ l₂}, forall₂ R l₁ l₂ → length l₁ = length l₂
| _ _ forall₂.nil          := rfl
| _ _ (forall₂.cons h₁ h₂) := congr_arg succ (forall₂_length_eq h₂)

theorem forall₂_zip {R : α → β → Prop} :
  ∀ {l₁ l₂}, forall₂ R l₁ l₂ → ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b
| _ _ (forall₂.cons h₁ h₂) x y (or.inl rfl) := h₁
| _ _ (forall₂.cons h₁ h₂) x y (or.inr h₃) := forall₂_zip h₂ h₃

theorem forall₂_iff_zip {R : α → β → Prop} {l₁ l₂} : forall₂ R l₁ l₂ ↔
  length l₁ = length l₂ ∧ ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b :=
⟨λ h, ⟨forall₂_length_eq h, @forall₂_zip _ _ _ _ _ h⟩,
 λ h, begin
  cases h with h₁ h₂,
  induction l₁ with a l₁ IH generalizing l₂,
  { cases length_eq_zero.1 h₁.symm, constructor },
  { cases l₂ with b l₂; injection h₁ with h₁,
    exact forall₂.cons (h₂ $ or.inl rfl) (IH h₁ $ λ a b h, h₂ $ or.inr h) }
end⟩

theorem forall₂_take {R : α → β → Prop} :
  ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (take n l₁) (take n l₂)
| 0 _ _ _ := by simp only [forall₂.nil, take]
| (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, take]
| (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_take n]

theorem forall₂_drop {R : α → β → Prop} :
  ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (drop n l₁) (drop n l₂)
| 0 _ _ h := by simp only [drop, h]
| (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, drop]
| (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_drop n]

theorem forall₂_take_append {R : α → β → Prop} (l : list α) (l₁ : list β) (l₂ : list β)
  (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.take (length l₁) l) l₁ :=
have h': forall₂ R (take (length l₁) l) (take (length l₁) (l₁ ++ l₂)),
from forall₂_take (length l₁) h,
by rwa [take_left] at h'

theorem forall₂_drop_append {R : α → β → Prop} (l : list α) (l₁ : list β) (l₂ : list β)
  (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.drop (length l₁) l) l₂ :=
have h': forall₂ R (drop (length l₁) l) (drop (length l₁) (l₁ ++ l₂)),
from forall₂_drop (length l₁) h,
by rwa [drop_left] at h'

lemma rel_mem (hr : bi_unique r) : (r ⇒ forall₂ r ⇒ iff) (∈) (∈)
| a b h [] [] forall₂.nil := by simp only [not_mem_nil]
| a b h (a' :: as) (b' :: bs) (forall₂.cons h₁ h₂) := rel_or (rel_eq hr h h₁) (rel_mem h h₂)

lemma rel_map : ((r ⇒ p) ⇒ forall₂ r ⇒ forall₂ p) map map
| f g h [] [] forall₂.nil := forall₂.nil
| f g h (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons (h h₁) (rel_map @h h₂)

lemma rel_append : (forall₂ r ⇒ forall₂ r ⇒ forall₂ r) append append
| [] [] h l₁ l₂ hl := hl
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) l₁ l₂ hl := forall₂.cons h₁ (rel_append h₂ hl)

lemma rel_reverse : (forall₂ r ⇒ forall₂ r) reverse reverse
| [] [] forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := begin
  simp only [reverse_cons],
  exact rel_append (rel_reverse h₂) (forall₂.cons h₁ forall₂.nil)
end

@[simp]
lemma forall₂_reverse_iff {l₁ l₂} : forall₂ r (reverse l₁) (reverse l₂) ↔ forall₂ r l₁ l₂ :=
iff.intro
  (λ h, by { rw [← reverse_reverse l₁, ← reverse_reverse l₂], exact rel_reverse h })
  (λ h, rel_reverse h)

lemma rel_join : (forall₂ (forall₂ r) ⇒ forall₂ r) join join
| [] [] forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := rel_append h₁ (rel_join h₂)

lemma rel_bind : (forall₂ r ⇒ (r ⇒ forall₂ p) ⇒ forall₂ p) list.bind list.bind :=
λ a b h₁ f g h₂, rel_join (rel_map @h₂ h₁)

lemma rel_foldl : ((p ⇒ r ⇒ p) ⇒ p ⇒ forall₂ r ⇒ p) foldl foldl
| f g hfg _ _ h _ _ forall₂.nil := h
| f g hfg x y hxy _ _ (forall₂.cons hab hs) := rel_foldl @hfg (hfg hxy hab) hs

lemma rel_foldr : ((r ⇒ p ⇒ p) ⇒ p ⇒ forall₂ r ⇒ p) foldr foldr
| f g hfg _ _ h _ _ forall₂.nil := h
| f g hfg x y hxy _ _ (forall₂.cons hab hs) := hfg hab (rel_foldr @hfg hxy hs)

lemma rel_filter {p : α → Prop} {q : β → Prop} [decidable_pred p] [decidable_pred q]
  (hpq : (r ⇒ (↔)) p q) :
  (forall₂ r ⇒ forall₂ r) (filter p) (filter q)
| _ _ forall₂.nil := forall₂.nil
| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) :=
  begin
    by_cases p a,
    { have : q b, { rwa [← hpq h₁] },
      simp only [filter_cons_of_pos _ h, filter_cons_of_pos _ this, forall₂_cons, h₁, rel_filter h₂,
        and_true], },
    { have : ¬ q b, { rwa [← hpq h₁] },
      simp only [filter_cons_of_neg _ h, filter_cons_of_neg _ this, rel_filter h₂], },
  end

lemma rel_filter_map : ((r ⇒ option.rel p) ⇒ forall₂ r ⇒ forall₂ p) filter_map filter_map
| f g hfg _ _ forall₂.nil := forall₂.nil
| f g hfg (a :: as) (b :: bs) (forall₂.cons h₁ h₂) :=
  by rw [filter_map_cons, filter_map_cons];
  from match f a, g b, hfg h₁ with
  | _, _, option.rel.none := rel_filter_map @hfg h₂
  | _, _, option.rel.some h := forall₂.cons h (rel_filter_map @hfg h₂)
  end

@[to_additive]
lemma rel_prod [monoid α] [monoid β]
  (h : r 1 1) (hf : (r ⇒ r ⇒ r) (*) (*)) : (forall₂ r ⇒ r) prod prod :=
rel_foldl hf h

/-- Given a relation `r`, `sublist_forall₂ r l₁ l₂` indicates that there is a sublist of `l₂` such
  that `forall₂ r l₁ l₂`. -/
inductive sublist_forall₂ (r : α → β → Prop) : list α → list β → Prop
| nil {l} : sublist_forall₂ [] l
| cons {a₁ a₂ l₁ l₂} : r a₁ a₂ → sublist_forall₂ l₁ l₂ →
  sublist_forall₂ (a₁ :: l₁) (a₂ :: l₂)
| cons_right {a l₁ l₂} : sublist_forall₂ l₁ l₂ → sublist_forall₂ l₁ (a :: l₂)

lemma sublist_forall₂_iff {l₁ : list α} {l₂ : list β} :
  sublist_forall₂ r l₁ l₂ ↔ ∃ l, forall₂ r l₁ l ∧ l <+ l₂ :=
begin
  split; intro h,
  { induction h with _ a b l1 l2 rab rll ih b l1 l2 hl ih,
    { exact ⟨nil, forall₂.nil, nil_sublist _⟩ },
    { obtain ⟨l, hl1, hl2⟩ := ih,
      refine ⟨b :: l, forall₂.cons rab hl1, hl2.cons_cons b⟩ },
    { obtain ⟨l, hl1, hl2⟩ := ih,
      exact ⟨l, hl1, hl2.trans (sublist.cons _ _ _ (sublist.refl _))⟩ } },
  { obtain ⟨l, hl1, hl2⟩ := h,
    revert l₁,
    induction hl2 with _ _ _ _ ih _ _ _ _ ih; intros l₁ hl1,
    { rw [forall₂_nil_right_iff.1 hl1],
      exact sublist_forall₂.nil },
    { exact sublist_forall₂.cons_right (ih hl1) },
    { cases hl1 with _ _ _ _ hr hl _,
      exact sublist_forall₂.cons hr (ih hl) } }
end

variable {ra : α → α → Prop}

instance sublist_forall₂.is_refl [is_refl α ra] :
  is_refl (list α) (sublist_forall₂ ra) :=
⟨λ l, sublist_forall₂_iff.2 ⟨l, forall₂_refl l, sublist.refl l⟩⟩

instance sublist_forall₂.is_trans [is_trans α ra] :
  is_trans (list α) (sublist_forall₂ ra) :=
⟨λ a b c, begin
  revert a b,
  induction c with _ _ ih,
  { rintros _ _ h1 (_ | _ | _),
    exact h1 },
  { rintros a b h1 h2,
    cases h2 with _ _ _ _ _ hbc tbc _ _ y1 btc,
    { cases h1,
      exact sublist_forall₂.nil },
    { cases h1 with _ _ _ _ _ hab tab _ _ _ atb,
      { exact sublist_forall₂.nil },
      { exact sublist_forall₂.cons (trans hab hbc) (ih _ _ tab tbc) },
      { exact sublist_forall₂.cons_right (ih _ _ atb tbc) } },
    { exact sublist_forall₂.cons_right (ih _ _ h1 btc), } }
end⟩

lemma sublist.sublist_forall₂ {l₁ l₂ : list α} (h : l₁ <+ l₂) (r : α → α → Prop) [is_refl α r] :
  sublist_forall₂ r l₁ l₂ :=
sublist_forall₂_iff.2 ⟨l₁, forall₂_refl l₁, h⟩

lemma tail_sublist_forall₂_self [is_refl α ra] (l : list α) :
  sublist_forall₂ ra l.tail l :=
l.tail_sublist.sublist_forall₂ ra

end list