import data.sum.basic
import lemmas

namespace coc
section

open expr
open ctx
open small
open small_star
open defeq
open judgment_index
open judgment

set_option pp.beta true
set_option pp.structure_projections false

local notation e ` ⟦`:80 n:80 ` ↦ `:80 e':79 `⟧`:79 := subst e n e'
local notation e ` ⟦`:80 n:80 ` ↟ `:80 m:79 `⟧`:79  := shift e n m
local notation e ` ~> `:50 e':50                    := small e e'
local notation e ` ~>* `:50 e':50                   := small_star e e'
local notation e ` ~~ `:50 e':50                    := defeq e e'
local notation `▷ `:50 Γ:50                         := judgment (well_ctx Γ )
local notation Γ ` ▷ `:50 e:50 ` : `:50 t:50        := judgment (has_type Γ e t)

/-- Performs applicative-order beta-reduction.
    If the original expression is well-typed, the resulting expression will have the same type.
    Note that this function is only a syntactic operation, and does not check well-formedness.
    It does not terminate on inputs like `(fun x => x x x) (fun x => x x x)`. -/
meta def expr.reduce : Π (e : expr), Σ' (e' : expr), e ~>* e'
| (sort s)   := ⟨sort s, ss_refl⟩
| (var v)    := ⟨var v, ss_refl⟩
| (app l r)  :=
  let ⟨l', hl⟩ := expr.reduce l,
      ⟨r', hr⟩ := expr.reduce r in
    match l', hl with
    | (lam t e), hl' :=
      let ⟨e', he⟩ := expr.reduce (e ⟦0 ↦ r'⟧) in
        ⟨e', small_star_trans (ss_step (app_small_star_aux hl' hr) s_beta) he⟩
    | _,         _   := ⟨app l' r', app_small_star_aux hl hr⟩
    end
| (lam t e)  :=
  let ⟨t', ht⟩ := expr.reduce t,
      ⟨e', he⟩ := expr.reduce e in
  ⟨lam t' e', lam_small_star_aux ht he⟩
| (pi t₁ t₂) :=
  let ⟨t₁', ht₁⟩ := expr.reduce t₁,
      ⟨t₂', ht₂⟩ := expr.reduce t₂ in
    ⟨pi t₁' t₂', pi_small_star_aux ht₁ ht₂⟩

/- Helper functions and auxiliary lemmas. -/

def expr.as_sort : Π (e : expr), string ⊕ Σ' (n : nat), e = sort n
| (sort s) := sum.inr ⟨s, rfl⟩
| e        := sum.inl $ "expression " ++ e.show ++ " is not a sort"

def expr.as_pi : Π (e : expr), string ⊕ Σ' (t₁ t₂ : expr), e = pi t₁ t₂
| (pi t₁ t₂) := sum.inr ⟨t₁, t₂, rfl⟩
| e          := sum.inl $ "expression " ++ e.show ++ " is not a function"

def ctx.try_nth : Π (Γ : ctx) (n : nat), string ⊕ Σ' (e : expr), list.nth Γ n = option.some e
| []       n       := sum.inl $ "variable index overflowed by " ++ to_string n
| (t :: Γ) 0       := sum.inr ⟨t, rfl⟩
| (t :: Γ) (n + 1) := ctx.try_nth Γ n

lemma expr.check_aux_1
  {Γ l tl} (htl : Γ ▷ l : tl) {t₁ t₂} (htt : tl = pi t₁ t₂) {r tr} (htr : Γ ▷ r : tr)
  {t₁'} (ht₁' : t₁ ~>* t₁') {tr'} (htr' : tr ~>* tr') (he : t₁' = tr') :
  (Γ ▷ app l r : t₂ ⟦0 ↦ r⟧) := by
{ substs htt he,
  have h₁ := has_type_conv_small_star htl (pi_small_star_aux ht₁' ss_refl),
  have h₂ := has_type_conv_small_star htr htr',
  exact t_app h₁ h₂ }

lemma expr.check_aux_2
  {Γ t t'} (ht' : Γ ▷ t : t') {s} (hs : t' = sort s) {e t₂} (ht₂ : t :: Γ ▷ e : t₂) :
  (Γ ▷ lam t e : pi t t₂) := by
{ subst hs,
  obtain ⟨s₂, hs₂⟩ := type_has_sort ht₂,
  exact t_lam (t_pi ht' hs₂) ht₂ }

/-- Check if a preterm is a well-formed term.
    Returns its type and the corresponding proof on success.
    It should terminate on any input, but there is no proof yet. -/
meta def expr.check : Π (e : expr) (Γ : ctx), ▷ Γ → string ⊕ Σ' (t : expr), Γ ▷ e : t
| (sort s)   Γ hw := return ⟨sort (s + 1), t_sort hw⟩
| (var v)    Γ hw := do ⟨t, h⟩ <- Γ.try_nth v, return ⟨t.shift 0 v.succ, t_var hw h⟩
| (app l r)  Γ hw := do
  { ⟨tl, htl⟩     ← l.check Γ hw,
    ⟨t₁, t₂, htt⟩ ← tl.as_pi,
    ⟨tr, htr⟩     ← r.check Γ hw,
    let ⟨t₁', ht₁'⟩ := t₁.reduce,
    let ⟨tr', htr'⟩ := tr.reduce,
    dite (t₁' = tr')
      (λ he, return ⟨t₂ ⟦0 ↦ r⟧, expr.check_aux_1 htl htt htr ht₁' htr' he⟩)
      (λ _, sum.inl $ "argument type mismatch: " ++ t₁.show ++ " != " ++ tr.show) }
| (lam t e)  Γ hw := do
  { ⟨t', ht'⟩     ← t.check Γ hw,
    ⟨s, hs⟩       ← t'.as_sort,
    ⟨t₂, ht₂⟩     ← e.check (t :: Γ) (c_cons (hs ▸ ht' : Γ ▷ t : sort s)),
    return ⟨pi t t₂, expr.check_aux_2 ht' hs ht₂⟩ }
| (pi t₁ t₂) Γ hw := do
  { ⟨t₁', ht₁'⟩   ← t₁.check Γ hw,
    ⟨s₁, hs₁⟩     ← t₁'.as_sort,
    ⟨t₂', ht₂'⟩   ← t₂.check (t₁ :: Γ) (c_cons (hs₁ ▸ ht₁' : Γ ▷ t₁ : sort s₁)),
    ⟨s₂, hs₂⟩     ← t₂'.as_sort,
    return ⟨sort (max s₁ s₂), t_pi (hs₁ ▸ ht₁') (hs₂ ▸ ht₂')⟩ }

/-- Check if a precontext is a well-formed context.
    Returns a proof on success. -/
meta def ctx.check : Π (Γ : ctx), string ⊕ Σ' (_ : unit), ▷ Γ
| []       := return ⟨(), c_nil⟩
| (t :: Γ) := do
  { ⟨_, hw⟩   ← ctx.check Γ,
    ⟨t', ht'⟩ ← t.check Γ hw,
    ⟨s, hs⟩   ← t'.as_sort,
    return ⟨(), c_cons (hs ▸ ht' : Γ ▷ t : sort s)⟩ }

end
end coc


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

/-!
# The category of boolean algebras

This defines `BoolAlg`, the category of boolean algebras.
-/

open order_dual opposite set

universes u

open category_theory

/-- The category of boolean algebras. -/
def BoolAlg := bundled boolean_algebra

namespace BoolAlg

instance : has_coe_to_sort BoolAlg Type* := bundled.has_coe_to_sort
instance (X : BoolAlg) : boolean_algebra X := X.str

/-- Construct a bundled `BoolAlg` from a `boolean_algebra`. -/
def of (α : Type*) [boolean_algebra α] : BoolAlg := bundled.of α

@[simp] lemma coe_of (α : Type*) [boolean_algebra α] : ↥(of α) = α := rfl

instance : inhabited BoolAlg := ⟨of punit⟩

/-- Turn a `BoolAlg` into a `BddDistLat` by forgetting its complement operation. -/
def to_BddDistLat (X : BoolAlg) : BddDistLat := BddDistLat.of X

@[simp] lemma coe_to_BddDistLat (X : BoolAlg) : ↥X.to_BddDistLat = ↥X := rfl

instance : large_category.{u} BoolAlg := induced_category.category to_BddDistLat
instance : concrete_category BoolAlg := induced_category.concrete_category to_BddDistLat

instance has_forget_to_BddDistLat : has_forget₂ BoolAlg BddDistLat :=
induced_category.has_forget₂ to_BddDistLat

section

local attribute [instance] bounded_lattice_hom_class.to_biheyting_hom_class

@[simps] instance has_forget_to_HeytAlg : has_forget₂ BoolAlg HeytAlg :=
{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, show bounded_lattice_hom X Y, from f } }

end

/-- Constructs an equivalence between Boolean algebras from an order isomorphism between them. -/
@[simps] def iso.mk {α β : BoolAlg.{u}} (e : α ≃o β) : α ≅ β :=
{ hom := (e : bounded_lattice_hom α β),
  inv := (e.symm : bounded_lattice_hom β α),
  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }

/-- `order_dual` as a functor. -/
@[simps] def dual : BoolAlg ⥤ BoolAlg :=
{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }

/-- The equivalence between `BoolAlg` and itself induced by `order_dual` both ways. -/
@[simps functor inverse] def dual_equiv : BoolAlg ≌ BoolAlg :=
equivalence.mk dual dual
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)

end BoolAlg

lemma BoolAlg_dual_comp_forget_to_BddDistLat :
  BoolAlg.dual ⋙ forget₂ BoolAlg BddDistLat =
    forget₂ BoolAlg BddDistLat ⋙ BddDistLat.dual := rfl


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

universes u l u_1 u_2 u_3

namespace Mathlib

/-!
# Polynomial functors

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

/--
A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/
structure pfunctor where
  A : Type u
  B : A → Type u

namespace pfunctor

protected instance inhabited : Inhabited pfunctor :=
  { default := mk Inhabited.default Inhabited.default }

/-- Applying `P` to an object of `Type` -/
def obj (P : pfunctor) (α : Type u_2) := sigma fun (x : A P) => B P x → α

/-- Applying `P` to a morphism of `Type` -/
def map (P : pfunctor) {α : Type u_2} {β : Type u_3} (f : α → β) : obj P α → obj P β :=
  fun (_x : obj P α) => sorry

protected instance obj.inhabited (P : pfunctor) {α : Type u} [Inhabited (A P)] [Inhabited α] :
    Inhabited (obj P α) :=
  { default := sigma.mk Inhabited.default fun (_x : B P Inhabited.default) => Inhabited.default }

protected instance obj.functor (P : pfunctor) : Functor (obj P) :=
  { map := map P, mapConst := fun (α β : Type u_2) => map P ∘ function.const β }

protected theorem map_eq (P : pfunctor) {α : Type u_2} {β : Type u_2} (f : α → β) (a : A P)
    (g : B P a → α) : f <$> sigma.mk a g = sigma.mk a (f ∘ g) :=
  rfl

protected theorem id_map (P : pfunctor) {α : Type u_2} (x : obj P α) : id <$> x = id x := sorry

protected theorem comp_map (P : pfunctor) {α : Type u_2} {β : Type u_2} {γ : Type u_2} (f : α → β)
    (g : β → γ) (x : obj P α) : (g ∘ f) <$> x = g <$> f <$> x :=
  sorry

protected instance obj.is_lawful_functor (P : pfunctor) : is_lawful_functor (obj P) :=
  is_lawful_functor.mk (pfunctor.id_map P) (pfunctor.comp_map P)

/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W (P : pfunctor) := W_type (B P)

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/

/-- root element  of a W tree -/
def W.head {P : pfunctor} : W P → A P := sorry

/-- children of the root of a W tree -/
def W.children {P : pfunctor} (x : W P) : B P (W.head x) → W P := sorry

/-- destructor for W-types -/
def W.dest {P : pfunctor} : W P → obj P (W P) := sorry

/-- constructor for W-types -/
def W.mk {P : pfunctor} : obj P (W P) → W P := sorry

@[simp] theorem W.dest_mk {P : pfunctor} (p : obj P (W P)) : W.dest (W.mk p) = p :=
  sigma.cases_on p
    fun (p_fst : A P) (p_snd : B P p_fst → W P) => Eq.refl (W.dest (W.mk (sigma.mk p_fst p_snd)))

@[simp] theorem W.mk_dest {P : pfunctor} (p : W P) : W.mk (W.dest p) = p :=
  W_type.cases_on p
    fun (p_a : A P) (p_f : B P p_a → W_type (B P)) => Eq.refl (W.mk (W.dest (W_type.mk p_a p_f)))

/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def Idx (P : pfunctor) := sigma fun (x : A P) => B P x

protected instance Idx.inhabited (P : pfunctor) [Inhabited (A P)]
    [Inhabited (B P Inhabited.default)] : Inhabited (Idx P) :=
  { default := sigma.mk Inhabited.default Inhabited.default }

/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def obj.iget {P : pfunctor} [DecidableEq (A P)] {α : Type u_2} [Inhabited α] (x : obj P α)
    (i : Idx P) : α :=
  dite (sigma.fst i = sigma.fst x)
    (fun (h : sigma.fst i = sigma.fst x) => sigma.snd x (cast sorry (sigma.snd i)))
    fun (h : ¬sigma.fst i = sigma.fst x) => Inhabited.default

@[simp] theorem fst_map {P : pfunctor} {α : Type u} {β : Type u} (x : obj P α) (f : α → β) :
    sigma.fst (f <$> x) = sigma.fst x :=
  sigma.cases_on x
    fun (x_fst : A P) (x_snd : B P x_fst → α) => Eq.refl (sigma.fst (f <$> sigma.mk x_fst x_snd))

@[simp] theorem iget_map {P : pfunctor} [DecidableEq (A P)] {α : Type u} {β : Type u} [Inhabited α]
    [Inhabited β] (x : obj P α) (f : α → β) (i : Idx P) (h : sigma.fst i = sigma.fst x) :
    obj.iget (f <$> x) i = f (obj.iget x i) :=
  sorry

end pfunctor

/-
Composition of polynomial functors.
-/

namespace pfunctor

/-- functor composition for polynomial functors -/
def comp (P₂ : pfunctor) (P₁ : pfunctor) : pfunctor :=
  mk (sigma fun (a₂ : A P₂) => B P₂ a₂ → A P₁)
    fun (a₂a₁ : sigma fun (a₂ : A P₂) => B P₂ a₂ → A P₁) =>
      sigma fun (u : B P₂ (sigma.fst a₂a₁)) => B P₁ (sigma.snd a₂a₁ u)

/-- constructor for composition -/
def comp.mk (P₂ : pfunctor) (P₁ : pfunctor) {α : Type} (x : obj P₂ (obj P₁ α)) :
    obj (comp P₂ P₁) α :=
  sigma.mk (sigma.mk (sigma.fst x) (sigma.fst ∘ sigma.snd x))
    fun (a₂a₁ : B (comp P₂ P₁) (sigma.mk (sigma.fst x) (sigma.fst ∘ sigma.snd x))) =>
      sigma.snd (sigma.snd x (sigma.fst a₂a₁)) (sigma.snd a₂a₁)

/-- destructor for composition -/
def comp.get (P₂ : pfunctor) (P₁ : pfunctor) {α : Type} (x : obj (comp P₂ P₁) α) :
    obj P₂ (obj P₁ α) :=
  sigma.mk (sigma.fst (sigma.fst x))
    fun (a₂ : B P₂ (sigma.fst (sigma.fst x))) =>
      sigma.mk (sigma.snd (sigma.fst x) a₂)
        fun (a₁ : B P₁ (sigma.snd (sigma.fst x) a₂)) => sigma.snd x (sigma.mk a₂ a₁)

end pfunctor

/-
Lifting predicates and relations.
-/

namespace pfunctor

theorem liftp_iff {P : pfunctor} {α : Type u} (p : α → Prop) (x : obj P α) :
    functor.liftp p x ↔ ∃ (a : A P), ∃ (f : B P a → α), x = sigma.mk a f ∧ ∀ (i : B P a), p (f i) :=
  sorry

theorem liftp_iff' {P : pfunctor} {α : Type u} (p : α → Prop) (a : A P) (f : B P a → α) :
    functor.liftp p (sigma.mk a f) ↔ ∀ (i : B P a), p (f i) :=
  sorry

theorem liftr_iff {P : pfunctor} {α : Type u} (r : α → α → Prop) (x : obj P α) (y : obj P α) :
    functor.liftr r x y ↔
        ∃ (a : A P),
          ∃ (f₀ : B P a → α),
            ∃ (f₁ : B P a → α),
              x = sigma.mk a f₀ ∧ y = sigma.mk a f₁ ∧ ∀ (i : B P a), r (f₀ i) (f₁ i) :=
  sorry

theorem supp_eq {P : pfunctor} {α : Type u} (a : A P) (f : B P a → α) :
    functor.supp (sigma.mk a f) = f '' set.univ :=
  sorry

end Mathlib


example : (0 : Nat) = Nat.zero := by
  simp only [OfNat.ofNat]

example : (0 : Fin 9) = (Fin.ofNat 0) := by
  simp only [OfNat.ofNat]


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

Definition of splitting fields, and definition of homomorphism into any field that splits
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.adjoin_root
import Mathlib.ring_theory.algebra_tower
import Mathlib.ring_theory.algebraic
import Mathlib.ring_theory.polynomial.default
import Mathlib.field_theory.minpoly
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.tactic.field_simp
import Mathlib.PostPort

universes u v w u_1 u_2 u_3 l

namespace Mathlib

namespace polynomial

/-- a polynomial `splits` iff it is zero or all of its irreducible factors have `degree` 1 -/
def splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) (f : polynomial α) :=
  f = 0 ∨ ∀ {g : polynomial β}, irreducible g → g ∣ map i f → degree g = 1

@[simp] theorem splits_zero {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) :
    splits i 0 :=
  Or.inl rfl

@[simp] theorem splits_C {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) (a : α) :
    splits i (coe_fn C a) :=
  sorry

theorem splits_of_degree_eq_one {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} (hf : degree f = 1) : splits i f :=
  sorry

theorem splits_of_degree_le_one {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} (hf : degree f ≤ 1) : splits i f :=
  sorry

theorem splits_mul {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {f : polynomial α}
    {g : polynomial α} (hf : splits i f) (hg : splits i g) : splits i (f * g) :=
  sorry

theorem splits_of_splits_mul {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {g : polynomial α} (hfg : f * g ≠ 0) (h : splits i (f * g)) :
    splits i f ∧ splits i g :=
  sorry

theorem splits_of_splits_of_dvd {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {g : polynomial α} (hf0 : f ≠ 0) (hf : splits i f) (hgf : g ∣ f) :
    splits i g :=
  sorry

theorem splits_of_splits_gcd_left {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {g : polynomial α} (hf0 : f ≠ 0) (hf : splits i f) :
    splits i (euclidean_domain.gcd f g) :=
  splits_of_splits_of_dvd i hf0 hf (euclidean_domain.gcd_dvd_left f g)

theorem splits_of_splits_gcd_right {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {g : polynomial α} (hg0 : g ≠ 0) (hg : splits i g) :
    splits i (euclidean_domain.gcd f g) :=
  splits_of_splits_of_dvd i hg0 hg (euclidean_domain.gcd_dvd_right f g)

theorem splits_map_iff {α : Type u} {β : Type v} {γ : Type w} [field α] [field β] [field γ]
    (i : α →+* β) (j : β →+* γ) {f : polynomial α} :
    splits j (map i f) ↔ splits (ring_hom.comp j i) f :=
  sorry

theorem splits_one {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) : splits i 1 :=
  splits_C i 1

theorem splits_of_is_unit {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {u : polynomial α} (hu : is_unit u) : splits i u :=
  splits_of_splits_of_dvd i one_ne_zero (splits_one i) (iff.mp is_unit_iff_dvd_one hu)

theorem splits_X_sub_C {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {x : α} :
    splits i (X - coe_fn C x) :=
  splits_of_degree_eq_one i (degree_X_sub_C x)

theorem splits_X {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) : splits i X :=
  splits_of_degree_eq_one i degree_X

theorem splits_id_iff_splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} : splits (ring_hom.id β) (map i f) ↔ splits i f :=
  sorry

theorem splits_mul_iff {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {g : polynomial α} (hf : f ≠ 0) (hg : g ≠ 0) :
    splits i (f * g) ↔ splits i f ∧ splits i g :=
  sorry

theorem splits_prod {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {ι : Type w}
    {s : ι → polynomial α} {t : finset ι} :
    (∀ (j : ι), j ∈ t → splits i (s j)) → splits i (finset.prod t fun (x : ι) => s x) :=
  sorry

theorem splits_prod_iff {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {ι : Type w}
    {s : ι → polynomial α} {t : finset ι} :
    (∀ (j : ι), j ∈ t → s j ≠ 0) →
        (splits i (finset.prod t fun (x : ι) => s x) ↔ ∀ (j : ι), j ∈ t → splits i (s j)) :=
  sorry

theorem degree_eq_one_of_irreducible_of_splits {β : Type v} [field β] {p : polynomial β}
    (h_nz : p ≠ 0) (hp : irreducible p) (hp_splits : splits (ring_hom.id β) p) : degree p = 1 :=
  sorry

theorem exists_root_of_splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} (hs : splits i f) (hf0 : degree f ≠ 0) : ∃ (x : β), eval₂ i x f = 0 :=
  sorry

theorem exists_multiset_of_splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} :
    splits i f →
        ∃ (s : multiset β),
          map i f =
            coe_fn C (coe_fn i (leading_coeff f)) *
              multiset.prod (multiset.map (fun (a : β) => X - coe_fn C a) s) :=
  sorry

/-- Pick a root of a polynomial that splits. -/
def root_of_splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {f : polynomial α}
    (hf : splits i f) (hfd : degree f ≠ 0) : β :=
  classical.some (exists_root_of_splits i hf hfd)

theorem map_root_of_splits {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} (hf : splits i f) (hfd : degree f ≠ 0) :
    eval₂ i (root_of_splits i hf hfd) f = 0 :=
  classical.some_spec (exists_root_of_splits i hf hfd)

theorem roots_map {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β) {f : polynomial α}
    (hf : splits (ring_hom.id α) f) : roots (map i f) = multiset.map (⇑i) (roots f) :=
  sorry

theorem eq_prod_roots_of_splits {α : Type u} {β : Type v} [field α] [field β] {p : polynomial α}
    {i : α →+* β} (hsplit : splits i p) :
    map i p =
        coe_fn C (coe_fn i (leading_coeff p)) *
          multiset.prod (multiset.map (fun (a : β) => X - coe_fn C a) (roots (map i p))) :=
  sorry

theorem eq_X_sub_C_of_splits_of_single_root {α : Type u} {β : Type v} [field α] [field β]
    (i : α →+* β) {x : α} {h : polynomial α} (h_splits : splits i h)
    (h_roots : roots (map i h) = singleton (coe_fn i x)) :
    h = coe_fn C (leading_coeff h) * (X - coe_fn C x) :=
  sorry

theorem nat_degree_multiset_prod {R : Type u_1} [integral_domain R] {s : multiset (polynomial R)}
    (h : ∀ (p : polynomial R), p ∈ s → p ≠ 0) :
    nat_degree (multiset.prod s) = multiset.sum (multiset.map nat_degree s) :=
  sorry

theorem nat_degree_eq_card_roots {α : Type u} {β : Type v} [field α] [field β] {p : polynomial α}
    {i : α →+* β} (hsplit : splits i p) : nat_degree p = coe_fn multiset.card (roots (map i p)) :=
  sorry

theorem degree_eq_card_roots {α : Type u} {β : Type v} [field α] [field β] {p : polynomial α}
    {i : α →+* β} (p_ne_zero : p ≠ 0) (hsplit : splits i p) :
    degree p = ↑(coe_fn multiset.card (roots (map i p))) :=
  sorry

theorem splits_of_exists_multiset {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} {s : multiset β}
    (hs :
      map i f =
        coe_fn C (coe_fn i (leading_coeff f)) *
          multiset.prod (multiset.map (fun (a : β) => X - coe_fn C a) s)) :
    splits i f :=
  sorry

theorem splits_of_splits_id {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} : splits (ring_hom.id α) f → splits i f :=
  sorry

theorem splits_iff_exists_multiset {α : Type u} {β : Type v} [field α] [field β] (i : α →+* β)
    {f : polynomial α} :
    splits i f ↔
        ∃ (s : multiset β),
          map i f =
            coe_fn C (coe_fn i (leading_coeff f)) *
              multiset.prod (multiset.map (fun (a : β) => X - coe_fn C a) s) :=
  sorry

theorem splits_comp_of_splits {α : Type u} {β : Type v} {γ : Type w} [field α] [field β] [field γ]
    (i : α →+* β) (j : β →+* γ) {f : polynomial α} (h : splits i f) :
    splits (ring_hom.comp j i) f :=
  sorry

/-- A monic polynomial `p` that has as much roots as its degree
can be written `p = ∏(X - a)`, for `a` in `p.roots`. -/
theorem prod_multiset_X_sub_C_of_monic_of_roots_card_eq {α : Type u} [field α] {p : polynomial α}
    (hmonic : monic p) (hroots : coe_fn multiset.card (roots p) = nat_degree p) :
    multiset.prod (multiset.map (fun (a : α) => X - coe_fn C a) (roots p)) = p :=
  sorry

/-- A polynomial `p` that has as much roots as its degree
can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`. -/
theorem C_leading_coeff_mul_prod_multiset_X_sub_C {α : Type u} [field α] {p : polynomial α}
    (hroots : coe_fn multiset.card (roots p) = nat_degree p) :
    coe_fn C (leading_coeff p) *
          multiset.prod (multiset.map (fun (a : α) => X - coe_fn C a) (roots p)) =
        p :=
  sorry

/-- A polynomial splits if and only if it has as much roots as its degree. -/
theorem splits_iff_card_roots {α : Type u} [field α] {p : polynomial α} :
    splits (ring_hom.id α) p ↔ coe_fn multiset.card (roots p) = nat_degree p :=
  sorry

end polynomial

/-- If `p` is the minimal polynomial of `a` over `F` then `F[a] ≃ₐ[F] F[x]/(p)` -/
def alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly (F : Type u_1) [field F] {R : Type u_2}
    [comm_ring R] [algebra F R] (x : R) :
    alg_equiv F (↥(algebra.adjoin F (singleton x))) (adjoin_root (minpoly F x)) :=
  alg_equiv.symm
    (alg_equiv.of_bijective
      (alg_hom.cod_restrict (adjoin_root.lift_hom (minpoly F x) x sorry)
        (algebra.adjoin F (singleton x)) sorry)
      sorry)

-- Speed up the following proof.

-- TODO: Why is this so slow?

/-- If `K` and `L` are field extensions of `F` and we have `s : finset K` such that
the minimal polynomial of each `x ∈ s` splits in `L` then `algebra.adjoin F s` embeds in `L`. -/
theorem lift_of_splits {F : Type u_1} {K : Type u_2} {L : Type u_3} [field F] [field K] [field L]
    [algebra F K] [algebra F L] (s : finset K) :
    (∀ (x : K), x ∈ s → is_integral F x ∧ polynomial.splits (algebra_map F L) (minpoly F x)) →
        Nonempty (alg_hom F (↥(algebra.adjoin F ↑s)) L) :=
  sorry

namespace polynomial

/-- Non-computably choose an irreducible factor from a polynomial. -/
def factor {α : Type u} [field α] (f : polynomial α) : polynomial α :=
  dite (∃ (g : polynomial α), irreducible g ∧ g ∣ f)
    (fun (H : ∃ (g : polynomial α), irreducible g ∧ g ∣ f) => classical.some H)
    fun (H : ¬∃ (g : polynomial α), irreducible g ∧ g ∣ f) => X

protected instance irreducible_factor {α : Type u} [field α] (f : polynomial α) :
    irreducible (factor f) :=
  sorry

theorem factor_dvd_of_not_is_unit {α : Type u} [field α] {f : polynomial α} (hf1 : ¬is_unit f) :
    factor f ∣ f :=
  sorry

theorem factor_dvd_of_degree_ne_zero {α : Type u} [field α] {f : polynomial α} (hf : degree f ≠ 0) :
    factor f ∣ f :=
  factor_dvd_of_not_is_unit (mt degree_eq_zero_of_is_unit hf)

theorem factor_dvd_of_nat_degree_ne_zero {α : Type u} [field α] {f : polynomial α}
    (hf : nat_degree f ≠ 0) : factor f ∣ f :=
  factor_dvd_of_degree_ne_zero (mt nat_degree_eq_of_degree_eq_some hf)

/-- Divide a polynomial f by X - C r where r is a root of f in a bigger field extension. -/
def remove_factor {α : Type u} [field α] (f : polynomial α) : polynomial (adjoin_root (factor f)) :=
  map (adjoin_root.of (factor f)) f /ₘ (X - coe_fn C (adjoin_root.root (factor f)))

theorem X_sub_C_mul_remove_factor {α : Type u} [field α] (f : polynomial α)
    (hf : nat_degree f ≠ 0) :
    (X - coe_fn C (adjoin_root.root (factor f))) * remove_factor f =
        map (adjoin_root.of (factor f)) f :=
  sorry

theorem nat_degree_remove_factor {α : Type u} [field α] (f : polynomial α) :
    nat_degree (remove_factor f) = nat_degree f - 1 :=
  sorry

theorem nat_degree_remove_factor' {α : Type u} [field α] {f : polynomial α} {n : ℕ}
    (hfn : nat_degree f = n + 1) : nat_degree (remove_factor f) = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree (remove_factor f) = n)) (nat_degree_remove_factor f)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nat_degree f - 1 = n)) hfn))
      (eq.mpr (id (Eq._oldrec (Eq.refl (n + 1 - 1 = n)) (nat.add_sub_cancel n 1))) (Eq.refl n)))

/-- Auxiliary construction to a splitting field of a polynomial. Uses induction on the degree. -/
def splitting_field_aux (n : ℕ) {α : Type u} [field α] (f : polynomial α) :
    nat_degree f = n → Type u :=
  nat.rec_on n
    (fun (α : Type u) (_x : field α) (_x_1 : polynomial α) (_x : nat_degree _x_1 = 0) => α)
    fun (n : ℕ)
      (ih : {α : Type u} → [_inst_4 : field α] → (f : polynomial α) → nat_degree f = n → Type u)
      (α : Type u) (_x : field α) (f : polynomial α) (hf : nat_degree f = Nat.succ n) =>
      ih (remove_factor f) (nat_degree_remove_factor' hf)

namespace splitting_field_aux

theorem succ {α : Type u} [field α] (n : ℕ) (f : polynomial α) (hfn : nat_degree f = n + 1) :
    splitting_field_aux (n + 1) f hfn =
        splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn) :=
  rfl

protected instance field (n : ℕ) {α : Type u} [field α] {f : polynomial α}
    (hfn : nat_degree f = n) : field (splitting_field_aux n f hfn) :=
  nat.rec_on n
    (fun (α : Type u) (_x : field α) (_x_1 : polynomial α) (_x_2 : nat_degree _x_1 = 0) => _x)
    fun (n : ℕ)
      (ih :
      {α : Type u} →
        [_inst_4 : field α] →
          {f : polynomial α} → (hfn : nat_degree f = n) → field (splitting_field_aux n f hfn))
      (α : Type u) (_x : field α) (f : polynomial α) (hf : nat_degree f = Nat.succ n) =>
      ih (nat_degree_remove_factor' hf)

protected instance inhabited {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n) : Inhabited (splitting_field_aux n f hfn) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

protected instance algebra (n : ℕ) {α : Type u} [field α] {f : polynomial α}
    (hfn : nat_degree f = n) : algebra α (splitting_field_aux n f hfn) :=
  nat.rec_on n
    (fun (α : Type u) (_x : field α) (_x_1 : polynomial α) (_x_2 : nat_degree _x_1 = 0) =>
      algebra.id α)
    fun (n : ℕ)
      (ih :
      {α : Type u} →
        [_inst_4 : field α] →
          {f : polynomial α} → (hfn : nat_degree f = n) → algebra α (splitting_field_aux n f hfn))
      (α : Type u) (_x : field α) (f : polynomial α) (hfn : nat_degree f = Nat.succ n) =>
      algebra.comap.algebra α (adjoin_root (factor f))
        (splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn))

protected instance algebra' {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n + 1) :
    algebra (adjoin_root (factor f)) (splitting_field_aux (n + 1) f hfn) :=
  splitting_field_aux.algebra n sorry

protected instance algebra'' {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n + 1) :
    algebra α (splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn)) :=
  splitting_field_aux.algebra (n + 1) hfn

protected instance algebra''' {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n + 1) :
    algebra (adjoin_root (factor f))
        (splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn)) :=
  splitting_field_aux.algebra n (nat_degree_remove_factor' hfn)

protected instance scalar_tower {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n + 1) :
    is_scalar_tower α (adjoin_root (factor f)) (splitting_field_aux (n + 1) f hfn) :=
  is_scalar_tower.of_algebra_map_eq fun (x : α) => rfl

protected instance scalar_tower' {α : Type u} [field α] {n : ℕ} {f : polynomial α}
    (hfn : nat_degree f = n + 1) :
    is_scalar_tower α (adjoin_root (factor f))
        (splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn)) :=
  is_scalar_tower.of_algebra_map_eq fun (x : α) => rfl

theorem algebra_map_succ {α : Type u} [field α] (n : ℕ) (f : polynomial α)
    (hfn : nat_degree f = n + 1) :
    algebra_map α (splitting_field_aux (n + 1) f hfn) =
        ring_hom.comp
          (algebra_map (adjoin_root (factor f))
            (splitting_field_aux n (remove_factor f) (nat_degree_remove_factor' hfn)))
          (adjoin_root.of (factor f)) :=
  rfl

protected theorem splits (n : ℕ) {α : Type u} [field α] (f : polynomial α)
    (hfn : nat_degree f = n) : splits (algebra_map α (splitting_field_aux n f hfn)) f :=
  sorry

theorem exists_lift (n : ℕ) {α : Type u} [field α] (f : polynomial α) (hfn : nat_degree f = n)
    {β : Type u_1} [field β] (j : α →+* β) (hf : splits j f) :
    ∃ (k : splitting_field_aux n f hfn →+* β),
        ring_hom.comp k (algebra_map α (splitting_field_aux n f hfn)) = j :=
  sorry

theorem adjoin_roots (n : ℕ) {α : Type u} [field α] (f : polynomial α) (hfn : nat_degree f = n) :
    algebra.adjoin α
          ↑(multiset.to_finset (roots (map (algebra_map α (splitting_field_aux n f hfn)) f))) =
        ⊤ :=
  sorry

end splitting_field_aux

/-- A splitting field of a polynomial. -/
def splitting_field {α : Type u} [field α] (f : polynomial α) :=
  splitting_field_aux (nat_degree f) f sorry

namespace splitting_field

protected instance field {α : Type u} [field α] (f : polynomial α) : field (splitting_field f) :=
  splitting_field_aux.field (nat_degree f) (_proof_1 f)

protected instance inhabited {α : Type u} [field α] (f : polynomial α) :
    Inhabited (splitting_field f) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

protected instance algebra {α : Type u} [field α] (f : polynomial α) :
    algebra α (splitting_field f) :=
  splitting_field_aux.algebra (nat_degree f) (_proof_1 f)

protected theorem splits {α : Type u} [field α] (f : polynomial α) :
    splits (algebra_map α (splitting_field f)) f :=
  splitting_field_aux.splits (nat_degree f) f (_proof_1 f)

/-- Embeds the splitting field into any other field that splits the polynomial. -/
def lift {α : Type u} {β : Type v} [field α] [field β] (f : polynomial α) [algebra α β]
    (hb : splits (algebra_map α β) f) : alg_hom α (splitting_field f) β :=
  alg_hom.mk (ring_hom.to_fun (classical.some sorry)) sorry sorry sorry sorry sorry

theorem adjoin_roots {α : Type u} [field α] (f : polynomial α) :
    algebra.adjoin α ↑(multiset.to_finset (roots (map (algebra_map α (splitting_field f)) f))) =
        ⊤ :=
  splitting_field_aux.adjoin_roots (nat_degree f) f (_proof_1 f)

end splitting_field

/-- Typeclass characterising splitting fields. -/
class is_splitting_field (α : Type u) (β : Type v) [field α] [field β] [algebra α β]
    (f : polynomial α)
    where
  splits : splits (algebra_map α β) f
  adjoin_roots : algebra.adjoin α ↑(multiset.to_finset (roots (map (algebra_map α β) f))) = ⊤

namespace is_splitting_field

protected instance splitting_field {α : Type u} [field α] (f : polynomial α) :
    is_splitting_field α (splitting_field f) f :=
  mk (splitting_field.splits f) (splitting_field.adjoin_roots f)

protected instance map {α : Type u} {β : Type v} {γ : Type w} [field α] [field β] [field γ]
    [algebra α β] [algebra β γ] [algebra α γ] [is_scalar_tower α β γ] (f : polynomial α)
    [is_splitting_field α γ f] : is_splitting_field β γ (map (algebra_map α β) f) :=
  sorry

theorem splits_iff {α : Type u} (β : Type v) [field α] [field β] [algebra α β] (f : polynomial α)
    [is_splitting_field α β f] : splits (ring_hom.id α) f ↔ ⊤ = ⊥ :=
  sorry

theorem mul {α : Type u} (β : Type v) {γ : Type w} [field α] [field β] [field γ] [algebra α β]
    [algebra β γ] [algebra α γ] [is_scalar_tower α β γ] (f : polynomial α) (g : polynomial α)
    (hf : f ≠ 0) (hg : g ≠ 0) [is_splitting_field α β f]
    [is_splitting_field β γ (map (algebra_map α β) g)] : is_splitting_field α γ (f * g) :=
  sorry

/-- Splitting field of `f` embeds into any field that splits `f`. -/
def lift {α : Type u} (β : Type v) {γ : Type w} [field α] [field β] [field γ] [algebra α β]
    [algebra α γ] (f : polynomial α) [is_splitting_field α β f] (hf : splits (algebra_map α γ) f) :
    alg_hom α β γ :=
  dite (f = 0)
    (fun (hf0 : f = 0) =>
      alg_hom.comp (algebra.of_id α γ)
        (alg_hom.comp (↑(algebra.bot_equiv α β)) (eq.mpr sorry algebra.to_top)))
    fun (hf0 : ¬f = 0) => alg_hom.comp (eq.mpr sorry (Classical.choice sorry)) algebra.to_top

theorem finite_dimensional {α : Type u} (β : Type v) [field α] [field β] [algebra α β]
    (f : polynomial α) [is_splitting_field α β f] : finite_dimensional α β :=
  sorry

/-- Any splitting field is isomorphic to `splitting_field f`. -/
def alg_equiv {α : Type u} (β : Type v) [field α] [field β] [algebra α β] (f : polynomial α)
    [is_splitting_field α β f] : alg_equiv α β (splitting_field f) :=
  alg_equiv.of_bijective (lift β f sorry) sorry

end Mathlib


example (x y z : Prop) (f : x → y → z) (xp : x) (yp : y) : z := by
  specialize f xp yp
  assumption

example (B C : Prop) (f : forall (A : Prop), A → C) (x : B) : C := by
  specialize f _ x
  exact f

example (B C : Prop) (f : forall {A : Prop}, A → C) (x : B) : C := by
  specialize f x
  exact f

example (B C : Prop) (f : forall {A : Prop}, A → C) (x : B) : C := by
  specialize @f _ x
  exact f

example (X : Type) [Add X] (f : forall {A : Type} [Add A], A → A → A) (x : X) : X := by
  specialize f x x
  assumption

def ex (f : Nat → Nat → Nat) : Nat := by
  specialize f _ _
  exact f
  exact 10
  exact 2

example : ex (. - .) = 8 :=
  rfl


import category_theory.limits.shapes.images

universes v u

noncomputable theory

open category_theory category_theory.limits

namespace category_theory.limits

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

variables {X Y : C} (f : X ⟶ Y)

@[simps]
def unique_factorise (I' : C) (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f) [strong_epi e] [mono m] :
  I' ≅ image f :=
{ hom := {strong_epi_mono_factorisation . I := I', m := m, e := e}.to_mono_is_image.lift _,
  inv := image.lift {strong_epi_mono_factorisation . I := I', m := m, e := e}.to_mono_factorisation,
  hom_inv_id' := by erw [← cancel_mono m, category.assoc, category.id_comp, image.lift_fac, is_image.lift_fac],
  inv_hom_id' := by erw [← cancel_mono (image.ι f), category.id_comp, category.assoc, is_image.lift_fac, image.lift_fac] }

lemma unique_factorise_hom_comp_image (I' : C) (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f) [strong_epi e] [mono m] :
  (unique_factorise f I' e m comm).hom ≫ image.ι f = m :=
is_image.lift_fac _ _

lemma unique_factorise_inv_comp_mono (I' : C) (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f) [strong_epi e] [mono m] :
  (unique_factorise f I' e m comm).inv ≫ m = image.ι f :=
image.lift_fac _

end category_theory.limits


import complexity_class.stack_rec
import polytime.basic
import polytime.stack_rec_size

open tree (stack_step iterator_stack stack_step_polysize)
open tencodable function polysize

namespace polytime

open_locale complexity_class

variables {α β γ δ : Type} [tencodable α] [tencodable β] [tencodable γ] [tencodable δ]

section stack_rec

attribute [complexity] complexity_class.stack_iterate

variables {base : γ → α → β} {pre₁ pre₂ : γ → tree unit → tree unit → α → α}
  {post : γ → β → β → tree unit → tree unit → α → β}

@[complexity]
protected theorem stack_rec [polysize α] [polysize β] [polysize γ] {st : γ -> tree unit} {arg : γ → α} (hst : st ∈ₑ PTIME) (harg : arg ∈ₑ PTIME) (hb : base ∈ₑ PTIME) (hpr₁ : pre₁ ∈ₑ PTIME) (hpr₂ : pre₂ ∈ₑ PTIME) (hpo : post ∈ₑ PTIME)
  (hpr₁' : polysize_safe (λ (usf : γ × tree unit × tree unit) (sf : α), pre₁ usf.1 usf.2.1 usf.2.2 sf))
  (hpr₂' : polysize_safe (λ (usf : γ × tree unit × tree unit) (sf : α), pre₂ usf.1 usf.2.1 usf.2.2 sf))
  (hpo' : polysize_safe (λ (usf : γ × tree unit × tree unit × α) (sf : β × β), post usf.1 sf.1 sf.2 usf.2.1 usf.2.2.1 usf.2.2.2)) :
  polytime.mem (λ x : γ, (st x).stack_rec (base x) (pre₁ x) (pre₂ x) (post x) (arg x)) :=
begin
  suffices : polytime.mem (λ x, (stack_step (base x) (pre₁ x) (pre₂ x) (post x))^[(st x).time_steps] [sum.inl (st x, arg x, none)]),
  { rw complexity_class.of_some,
    convert complexity_class.mem.comp (show polytime.mem (λ x : list (iterator_stack α β), x.head'.bind sum.get_right), by complexity) this,
    simp, },
  apply iterate, { dsimp only [tree.time_steps], complexity, }, { complexity, }, { complexity, },
  cases stack_step_polysize (polytime.size_le hst) (polytime.size_le harg)
    (polytime.size_le hb) hpr₁' hpr₂' hpo' with p hp,
  use p, intros x m _, exact hp x m,
end

lemma tree_eq : polytime.mem_pred (@eq (tree unit)) :=
begin
  rw ← complexity_class.mem_iff_mem_rel,
  complexity using λ x y, x.stack_rec (λ y' : tree unit, (y' = tree.nil : bool))
    (λ _ _ y', y'.left) (λ _ _ y', y'.right)
    (λ b₁ b₂ _ _ y, !(y = tree.nil : bool) && (b₁ && b₂)) y,
  { use 0, simp, },
  induction x using tree.unit_rec_on with l r ih₁ ih₂ generalizing y; cases y; simp [*],
end

@[complexity] lemma eq : (@eq α) ∈ₚ PTIME :=
by { have := tree_eq, complexity using (λ x y, encode x = encode y), simp, }

@[complexity] lemma tree_cmp : (@tree.cmp unit _ _) ∈ₑ PTIME :=
begin
  complexity using λ x y,
    x.stack_rec (λ y', if y' = tree.nil then ordering.eq else ordering.lt)
      (λ _ _ y', y'.left) (λ _ _ y', y'.right)
      (λ c₁ c₂ _ _ y', if y' = tree.nil then ordering.gt else c₁.or_else c₂) y,
  { use 0, simp, },
  induction x using tree.unit_rec_on with l r ih₁ ih₂ generalizing y; rcases y with _|⟨⟨⟩, _, _⟩; simp [*, tree.cmp, ordering.or_else],
end

@[complexity] lemma tree_lt : ((<) : tree unit → tree unit → Prop) ∈ₚ PTIME :=
by { complexity using λ x y, x.cmp y = ordering.lt, rw tree.tree_lt_def, }

@[complexity] lemma tree_le : ((≤) : tree unit → tree unit → Prop) ∈ₚ PTIME :=
by { complexity using λ x y, ¬(y < x), simp, }

end stack_rec

end polytime


import tactic data.set
import prop.language prop.semantics prop.syntax

namespace prop

lemma axiomL_tautology (v φ) : φ ∈ AxiomL → (v ⊨ φ) :=
begin
  intro h,
  cases h,
  case P1: {
    sorry
  },
  case P2: {
    sorry
  },
  case P3: {
    sorry
  },
end

theorem soundness (v φ) : ⊢ₗ φ → v ⊨ φ :=
begin
  intro he,
  induction he,

  case in_axioms : _ _ hA {
    exact @axiomL_tautology v _ hA,
  },

  case in_context :{
    sorry,
  },

  case mp :{
    sorry,
  },
end

end prop


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computability.tm_computable

/-!
# Polynomial time stuff to eventually port to mathlib
-/

section poly_time

open turing computability

/-- A function is computable in polynomial time if there is a polynomial time implementation.
  In particular this definition is extensional, so the definition of the function isn't important,
  as long as there is a Turing machine implementing the same input/output behaviour. -/
def poly_time {α β : Type*} (f : α → β) :=
Σ (ea : fin_encoding α) (eb : fin_encoding β),
  tm2_computable_in_poly_time ea eb f

noncomputable lemma poly_time_id (α : Type) (ea : fin_encoding α) : poly_time (id : α → α) :=
⟨ea, ea, id_computable_in_poly_time ea⟩

end poly_time


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Calle Sönne
-/

import topology.category.CompHaus
import topology.connected
import topology.subset_properties
import topology.locally_constant.basic
import category_theory.adjunction.reflective
import category_theory.monad.limits
import category_theory.limits.constructions.epi_mono
import category_theory.Fintype

/-!
# The category of Profinite Types

We construct the category of profinite topological spaces,
often called profinite sets -- perhaps they could be called
profinite types in Lean.

The type of profinite topological spaces is called `Profinite`. It has a category
instance and is a fully faithful subcategory of `Top`. The fully faithful functor
is called `Profinite_to_Top`.

## Implementation notes

A profinite type is defined to be a topological space which is
compact, Hausdorff and totally disconnected.

## TODO

0. Link to category of projective limits of finite discrete sets.
1. finite coproducts
2. Clausen/Scholze topology on the category `Profinite`.

## Tags

profinite

-/

universe u

open category_theory

/-- The type of profinite topological spaces. -/
structure Profinite :=
(to_CompHaus : CompHaus)
[is_totally_disconnected : totally_disconnected_space to_CompHaus]

namespace Profinite

/--
Construct a term of `Profinite` from a type endowed with the structure of a
compact, Hausdorff and totally disconnected topological space.
-/
def of (X : Type*) [topological_space X] [compact_space X] [t2_space X]
  [totally_disconnected_space X] : Profinite := ⟨⟨⟨X⟩⟩⟩

instance : inhabited Profinite := ⟨Profinite.of pempty⟩

instance category : category Profinite := induced_category.category to_CompHaus
instance concrete_category : concrete_category Profinite := induced_category.concrete_category _
instance has_forget₂ : has_forget₂ Profinite Top := induced_category.has_forget₂ _

instance : has_coe_to_sort Profinite Type* := ⟨λ X, X.to_CompHaus⟩
instance {X : Profinite} : totally_disconnected_space X := X.is_totally_disconnected

-- We check that we automatically infer that Profinite sets are compact and Hausdorff.
example {X : Profinite} : compact_space X := infer_instance
example {X : Profinite} : t2_space X := infer_instance

@[simp]
lemma coe_to_CompHaus {X : Profinite} : (X.to_CompHaus : Type*) = X :=
rfl

@[simp] lemma coe_id (X : Profinite) : (𝟙 X : X → X) = id := rfl

@[simp] lemma coe_comp {X Y Z : Profinite} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f := rfl

end Profinite

/-- The fully faithful embedding of `Profinite` in `CompHaus`. -/
@[simps, derive [full, faithful]]
def Profinite_to_CompHaus : Profinite ⥤ CompHaus := induced_functor _

/-- The fully faithful embedding of `Profinite` in `Top`. This is definitionally the same as the
obvious composite. -/
@[simps, derive [full, faithful]]
def Profinite.to_Top : Profinite ⥤ Top := forget₂ _ _

@[simp] lemma Profinite.to_CompHaus_to_Top :
  Profinite_to_CompHaus ⋙ CompHaus_to_Top = Profinite.to_Top :=
rfl

section Profinite
local attribute [instance] connected_component_setoid

/--
(Implementation) The object part of the connected_components functor from compact Hausdorff spaces
to Profinite spaces, given by quotienting a space by its connected components.
See: https://stacks.math.columbia.edu/tag/0900
-/
-- Without explicit universe annotations here, Lean introduces two universe variables and
-- unhelpfully defines a function `CompHaus.{max u₁ u₂} → Profinite.{max u₁ u₂}`.
def CompHaus.to_Profinite_obj (X : CompHaus.{u}) : Profinite.{u} :=
{ to_CompHaus :=
  { to_Top := Top.of (connected_components X),
    is_compact := quotient.compact_space,
    is_hausdorff := connected_components.t2 },
  is_totally_disconnected := connected_components.totally_disconnected_space }

/--
(Implementation) The bijection of homsets to establish the reflective adjunction of Profinite
spaces in compact Hausdorff spaces.
-/
def Profinite.to_CompHaus_equivalence (X : CompHaus.{u}) (Y : Profinite.{u}) :
  (CompHaus.to_Profinite_obj X ⟶ Y) ≃ (X ⟶ Profinite_to_CompHaus.obj Y) :=
{ to_fun := λ f,
  { to_fun := f.1 ∘ quotient.mk,
    continuous_to_fun := continuous.comp f.2 (continuous_quotient_mk) },
  inv_fun := λ g,
    { to_fun := continuous.connected_components_lift g.2,
      continuous_to_fun := continuous.connected_components_lift_continuous g.2},
  left_inv := λ f, continuous_map.ext $ λ x, quotient.induction_on x $ λ a, rfl,
  right_inv := λ f, continuous_map.ext $ λ x, rfl }

/--
The connected_components functor from compact Hausdorff spaces to profinite spaces,
left adjoint to the inclusion functor.
-/
def CompHaus.to_Profinite : CompHaus ⥤ Profinite :=
adjunction.left_adjoint_of_equiv Profinite.to_CompHaus_equivalence (λ _ _ _ _ _, rfl)

lemma CompHaus.to_Profinite_obj' (X : CompHaus) :
  ↥(CompHaus.to_Profinite.obj X) = connected_components X := rfl

/-- Finite types are given the discrete topology. -/
def Fintype.discrete_topology (A : Fintype) : topological_space A := ⊥

section discrete_topology

local attribute [instance] Fintype.discrete_topology

/-- The natural functor from `Fintype` to `Profinite`, endowing a finite type with the
discrete topology. -/
@[simps] def Fintype.to_Profinite : Fintype ⥤ Profinite :=
{ obj := λ A, Profinite.of A,
  map := λ _ _ f, ⟨f⟩ }

end discrete_topology

end Profinite

namespace Profinite

/-- An explicit limit cone for a functor `F : J ⥤ Profinite`, defined in terms of
`Top.limit_cone`. -/
def limit_cone {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
  limits.cone F :=
{ X :=
  { to_CompHaus := (CompHaus.limit_cone (F ⋙ Profinite_to_CompHaus)).X,
    is_totally_disconnected :=
    begin
      change totally_disconnected_space ↥{u : Π (j : J), (F.obj j) | _},
      exact subtype.totally_disconnected_space,
    end },
  π := { app := (CompHaus.limit_cone (F ⋙ Profinite_to_CompHaus)).π.app } }

/-- The limit cone `Profinite.limit_cone F` is indeed a limit cone. -/
def limit_cone_is_limit {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
  limits.is_limit (limit_cone F) :=
{ lift := λ S, (CompHaus.limit_cone_is_limit (F ⋙ Profinite_to_CompHaus)).lift
    (Profinite_to_CompHaus.map_cone S),
  uniq' := λ S m h,
    (CompHaus.limit_cone_is_limit _).uniq (Profinite_to_CompHaus.map_cone S) _ h }

/-- The adjunction between CompHaus.to_Profinite and Profinite.to_CompHaus -/
def to_Profinite_adj_to_CompHaus : CompHaus.to_Profinite ⊣ Profinite_to_CompHaus :=
adjunction.adjunction_of_equiv_left _ _

/-- The category of profinite sets is reflective in the category of compact hausdroff spaces -/
instance to_CompHaus.reflective : reflective Profinite_to_CompHaus :=
{ to_is_right_adjoint := ⟨CompHaus.to_Profinite, Profinite.to_Profinite_adj_to_CompHaus⟩ }

noncomputable
instance to_CompHaus.creates_limits : creates_limits Profinite_to_CompHaus :=
monadic_creates_limits _

noncomputable
instance to_Top.reflective : reflective Profinite.to_Top :=
reflective.comp Profinite_to_CompHaus CompHaus_to_Top

noncomputable
instance to_Top.creates_limits : creates_limits Profinite.to_Top :=
monadic_creates_limits _

instance has_limits : limits.has_limits Profinite :=
has_limits_of_has_limits_creates_limits Profinite.to_Top

instance has_colimits : limits.has_colimits Profinite :=
has_colimits_of_reflective Profinite_to_CompHaus

noncomputable
instance forget_preserves_limits : limits.preserves_limits (forget Profinite) :=
by apply limits.comp_preserves_limits Profinite.to_Top (forget Top)

variables {X Y : Profinite.{u}} (f : X ⟶ Y)

/-- Any morphism of profinite spaces is a closed map. -/
lemma is_closed_map : is_closed_map f :=
CompHaus.is_closed_map _

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
lemma is_iso_of_bijective (bij : function.bijective f) : is_iso f :=
begin
  haveI := CompHaus.is_iso_of_bijective (Profinite_to_CompHaus.map f) bij,
  exact is_iso_of_fully_faithful Profinite_to_CompHaus _
end

/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
noncomputable def iso_of_bijective (bij : function.bijective f) : X ≅ Y :=
by letI := Profinite.is_iso_of_bijective f bij; exact as_iso f

instance forget_reflects_isomorphisms : reflects_isomorphisms (forget Profinite) :=
⟨by introsI A B f hf; exact Profinite.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩

/-- Construct an isomorphism from a homeomorphism. -/
@[simps hom inv] def iso_of_homeo (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f, f.continuous⟩,
  inv := ⟨f.symm, f.symm.continuous⟩,
  hom_inv_id' := by { ext x, exact f.symm_apply_apply x },
  inv_hom_id' := by { ext x, exact f.apply_symm_apply x } }

/-- Construct a homeomorphism from an isomorphism. -/
@[simps] def homeo_of_iso (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by { change (f.hom ≫ f.inv) x = x, rw [iso.hom_inv_id, coe_id, id.def] },
  right_inv := λ x, by { change (f.inv ≫ f.hom) x = x, rw [iso.inv_hom_id, coe_id, id.def] },
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

/-- The equivalence between isomorphisms in `Profinite` and homeomorphisms
of topological spaces. -/
@[simps] def iso_equiv_homeo : (X ≅ Y) ≃ (X ≃ₜ Y) :=
{ to_fun := homeo_of_iso,
  inv_fun := iso_of_homeo,
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

lemma epi_iff_surjective {X Y : Profinite.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
begin
  split,
  { contrapose!,
    rintros ⟨y, hy⟩ hf,
    let C := set.range f,
    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
    let U := Cᶜ,
    have hU : is_open U := is_open_compl_iff.mpr hC,
    have hyU : y ∈ U,
    { refine set.mem_compl _, rintro ⟨y', hy'⟩, exact hy y' hy' },
    have hUy : U ∈ nhds y := hU.mem_nhds hyU,
    obtain ⟨V, hV, hyV, hVU⟩ := is_topological_basis_clopen.mem_nhds_iff.mp hUy,
    classical,
    letI : topological_space (ulift.{u} $ fin 2) := ⊥,
    let Z := of (ulift.{u} $ fin 2),
    let g : Y ⟶ Z := ⟨(locally_constant.of_clopen hV).map ulift.up, locally_constant.continuous _⟩,
    let h : Y ⟶ Z := ⟨λ _, ⟨1⟩, continuous_const⟩,
    have H : h = g,
    { rw ← cancel_epi f,
      ext x, dsimp [locally_constant.of_clopen],
      rw if_neg, { refl },
      refine mt (λ α, hVU α) _,
      simp only [set.mem_range_self, not_true, not_false_iff, set.mem_compl_eq], },
    apply_fun (λ e, (e y).down) at H,
    dsimp [locally_constant.of_clopen] at H,
    rw if_pos hyV at H,
    exact top_ne_bot H },
  { rw ← category_theory.epi_iff_surjective,
    apply faithful_reflects_epi (forget Profinite) },
end

lemma mono_iff_injective {X Y : Profinite.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
begin
  split,
  { intro h,
    haveI : limits.preserves_limits Profinite_to_CompHaus := infer_instance,
    haveI : mono (Profinite_to_CompHaus.map f) := infer_instance,
    rwa ← CompHaus.mono_iff_injective },
  { rw ← category_theory.mono_iff_injective,
    apply faithful_reflects_mono (forget Profinite) }
end

end Profinite


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import category_theory.concrete_category.basic

/-!
# The category of pointed types

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

This defines `Pointed`, the category of pointed types.

## TODO

* Monoidal structure
* Upgrade `Type_to_Pointed` to an equivalence
-/

open category_theory

universes u
variables {α β : Type*}

/-- The category of pointed types. -/
structure Pointed : Type.{u + 1} :=
(X : Type.{u})
(point : X)

namespace Pointed

instance : has_coe_to_sort Pointed Type* := ⟨X⟩

attribute [protected] Pointed.X

/-- Turns a point into a pointed type. -/
def of {X : Type*} (point : X) : Pointed := ⟨X, point⟩

@[simp] lemma coe_of {X : Type*} (point : X) : ↥(of point) = X := rfl

alias of ← _root_.prod.Pointed

instance : inhabited Pointed := ⟨of ((), ())⟩

/-- Morphisms in `Pointed`. -/
@[ext] protected structure hom (X Y : Pointed.{u}) : Type u :=
(to_fun : X → Y)
(map_point : to_fun X.point = Y.point)

namespace hom

/-- The identity morphism of `X : Pointed`. -/
@[simps] def id (X : Pointed) : hom X X := ⟨id, rfl⟩

instance (X : Pointed) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of `Pointed`. -/
@[simps] def comp {X Y Z : Pointed.{u}} (f : hom X Y) (g : hom Y Z) : hom X Z :=
⟨g.to_fun ∘ f.to_fun, by rw [function.comp_apply, f.map_point, g.map_point]⟩

end hom

instance large_category : large_category Pointed :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp,
  id_comp' := λ _ _ _, hom.ext _ _ rfl,
  comp_id' := λ _ _ _, hom.ext _ _ rfl,
  assoc' := λ _ _ _ _ _ _ _, hom.ext _ _ rfl }

instance concrete_category : concrete_category Pointed :=
{ forget := { obj := Pointed.X, map := @hom.to_fun },
  forget_faithful := ⟨@hom.ext⟩ }

/-- Constructs a isomorphism between pointed types from an equivalence that preserves the point
between them. -/
@[simps] def iso.mk {α β : Pointed} (e : α ≃ β) (he : e α.point = β.point) : α ≅ β :=
{ hom := ⟨e, he⟩,
  inv := ⟨e.symm, e.symm_apply_eq.2 he.symm⟩,
  hom_inv_id' := Pointed.hom.ext _ _ e.symm_comp_self,
  inv_hom_id' := Pointed.hom.ext _ _ e.self_comp_symm }

end Pointed

/-- `option` as a functor from types to pointed types. This is the free functor. -/
@[simps] def Type_to_Pointed : Type.{u} ⥤ Pointed.{u} :=
{ obj := λ X, ⟨option X, none⟩,
  map := λ X Y f, ⟨option.map f, rfl⟩,
  map_id' := λ X, Pointed.hom.ext _ _ option.map_id,
  map_comp' := λ X Y Z f g, Pointed.hom.ext _ _ (option.map_comp_map _ _).symm }

/-- `Type_to_Pointed` is the free functor. -/
def Type_to_Pointed_forget_adjunction : Type_to_Pointed ⊣ forget Pointed :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, { to_fun := λ f, f.to_fun ∘ option.some,
                        inv_fun := λ f, ⟨λ o, o.elim Y.point f, rfl⟩,
                        left_inv := λ f, by { ext, cases x, exact f.map_point.symm, refl },
                        right_inv := λ f, funext $ λ _, rfl },
  hom_equiv_naturality_left_symm' := λ X' X Y f g, by { ext, cases x; refl }, }


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import category_theory.category.Cat
import category_theory.groupoid

/-!
# Objects of a category up to an isomorphism

`is_isomorphic X Y := nonempty (X ≅ Y)` is an equivalence relation on the objects of a category.
The quotient with respect to this relation defines a functor from our category to `Type`.
-/

universes v u

namespace category_theory

section category

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

/-- An object `X` is isomorphic to an object `Y`, if `X ≅ Y` is not empty. -/
def is_isomorphic : C → C → Prop := λ X Y, nonempty (X ≅ Y)

variable (C)

/-- `is_isomorphic` defines a setoid. -/
def is_isomorphic_setoid : setoid C :=
{ r := is_isomorphic,
  iseqv := ⟨λ X, ⟨iso.refl X⟩, λ X Y ⟨α⟩, ⟨α.symm⟩, λ X Y Z ⟨α⟩ ⟨β⟩, ⟨α.trans β⟩⟩ }

end category

/--
The functor that sends each category to the quotient space of its objects up to an isomorphism.
-/
def isomorphism_classes : Cat.{v u} ⥤ Type u :=
{ obj := λ C, quotient (is_isomorphic_setoid C.α),
  map := λ C D F, quot.map F.obj $ λ X Y ⟨f⟩, ⟨F.map_iso f⟩ }

lemma groupoid.is_isomorphic_iff_nonempty_hom {C : Type u} [groupoid.{v} C] {X Y : C} :
  is_isomorphic X Y ↔ nonempty (X ⟶ Y) :=
(groupoid.iso_equiv_hom X Y).nonempty_iff_nonempty

-- PROJECT: define `skeletal`, and show every category is equivalent to a skeletal category,
-- using the axiom of choice to pick a representative of every isomorphism class.
end category_theory


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Sébastien Gouëzel, Patrick Massot
-/
import topology.uniform_space.cauchy
import topology.uniform_space.separation
import topology.dense_embedding

/-!
# Uniform embeddings of uniform spaces.

Extension of uniform continuous functions.
-/

open filter topological_space set classical
open_locale classical uniformity topological_space filter

section
variables {α : Type*} {β : Type*} {γ : Type*}
          [uniform_space α] [uniform_space β] [uniform_space γ]
universe u

structure uniform_inducing (f : α → β) : Prop :=
(comap_uniformity : comap (λx:α×α, (f x.1, f x.2)) (𝓤 β) = 𝓤 α)

lemma uniform_inducing.mk' {f : α → β} (h : ∀ s, s ∈ 𝓤 α ↔
    ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s) : uniform_inducing f :=
⟨by simp [eq_comm, filter.ext_iff, subset_def, h]⟩

lemma uniform_inducing.comp {g : β → γ} (hg : uniform_inducing g)
  {f : α → β} (hf : uniform_inducing f) : uniform_inducing (g ∘ f) :=
⟨ by rw [show (λ (x : α × α), ((g ∘ f) x.1, (g ∘ f) x.2)) =
         (λ y : β × β, (g y.1, g y.2)) ∘ (λ x : α × α, (f x.1, f x.2)), by ext ; simp,
        ← filter.comap_comap, hg.1, hf.1]⟩

structure uniform_embedding (f : α → β) extends uniform_inducing f : Prop :=
(inj : function.injective f)

lemma uniform_embedding_subtype_val {p : α → Prop} :
  uniform_embedding (subtype.val : subtype p → α) :=
{ comap_uniformity := rfl,
  inj := subtype.val_injective }

lemma uniform_embedding_subtype_coe {p : α → Prop} :
  uniform_embedding (coe : subtype p → α) :=
uniform_embedding_subtype_val

lemma uniform_embedding_set_inclusion {s t : set α} (hst : s ⊆ t) :
  uniform_embedding (inclusion hst) :=
{ comap_uniformity :=
    by { erw [uniformity_subtype, uniformity_subtype, comap_comap], congr },
  inj := inclusion_injective hst }

lemma uniform_embedding.comp {g : β → γ} (hg : uniform_embedding g)
  {f : α → β} (hf : uniform_embedding f) : uniform_embedding (g ∘ f) :=
{ inj := hg.inj.comp hf.inj,
  ..hg.to_uniform_inducing.comp hf.to_uniform_inducing }

theorem uniform_embedding_def {f : α → β} :
  uniform_embedding f ↔ function.injective f ∧ ∀ s, s ∈ 𝓤 α ↔
    ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s :=
begin
  split,
  { rintro ⟨⟨h⟩, h'⟩,
    rw [eq_comm, filter.ext_iff] at h,
    simp [*, subset_def] },
  { rintro ⟨h, h'⟩,
    refine uniform_embedding.mk ⟨_⟩ h,
    rw [eq_comm, filter.ext_iff],
    simp [*, subset_def] }
end

theorem uniform_embedding_def' {f : α → β} :
  uniform_embedding f ↔ function.injective f ∧ uniform_continuous f ∧
    ∀ s, s ∈ 𝓤 α →
      ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s :=
by simp only [uniform_embedding_def, uniform_continuous_def]; exact
⟨λ ⟨I, H⟩, ⟨I, λ s su, (H _).2 ⟨s, su, λ x y, id⟩, λ s, (H s).1⟩,
 λ ⟨I, H₁, H₂⟩, ⟨I, λ s, ⟨H₂ s,
   λ ⟨t, tu, h⟩, mem_sets_of_superset (H₁ t tu) (λ ⟨a, b⟩, h a b)⟩⟩⟩

lemma uniform_inducing.uniform_continuous {f : α → β}
  (hf : uniform_inducing f) : uniform_continuous f :=
by simp [uniform_continuous, hf.comap_uniformity.symm, tendsto_comap]

lemma uniform_inducing.uniform_continuous_iff {f : α → β} {g : β → γ} (hg : uniform_inducing g) :
  uniform_continuous f ↔ uniform_continuous (g ∘ f) :=
by { dsimp only [uniform_continuous, tendsto],
  rw [← hg.comap_uniformity, ← map_le_iff_le_comap, filter.map_map] }

lemma uniform_inducing.inducing {f : α → β} (h : uniform_inducing f) : inducing f :=
begin
  refine ⟨eq_of_nhds_eq_nhds $ assume a, _ ⟩,
  rw [nhds_induced, nhds_eq_uniformity, nhds_eq_uniformity, ← h.comap_uniformity,
    comap_lift'_eq, comap_lift'_eq2];
    { refl <|> exact monotone_preimage }
end

lemma uniform_inducing.prod {α' : Type*} {β' : Type*} [uniform_space α'] [uniform_space β']
  {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_inducing e₁) (h₂ : uniform_inducing e₂) :
  uniform_inducing (λp:α×β, (e₁ p.1, e₂ p.2)) :=
⟨by simp [(∘), uniformity_prod, h₁.comap_uniformity.symm, h₂.comap_uniformity.symm,
           comap_inf, comap_comap]⟩

lemma uniform_inducing.dense_inducing {f : α → β} (h : uniform_inducing f) (hd : dense_range f) :
  dense_inducing f :=
{ dense   := hd,
  induced := h.inducing.induced }

lemma uniform_embedding.embedding {f : α → β} (h : uniform_embedding f) : embedding f :=
{ induced := h.to_uniform_inducing.inducing.induced,
  inj := h.inj }

lemma uniform_embedding.dense_embedding {f : α → β} (h : uniform_embedding f) (hd : dense_range f) :
  dense_embedding f :=
{ dense   := hd,
  inj     := h.inj,
  induced := h.embedding.induced }

lemma closure_image_mem_nhds_of_uniform_inducing
  {s : set (α×α)} {e : α → β} (b : β)
  (he₁ : uniform_inducing e) (he₂ : dense_inducing e) (hs : s ∈ 𝓤 α) :
  ∃a, closure (e '' {a' | (a, a') ∈ s}) ∈ 𝓝 b :=
have s ∈ comap (λp:α×α, (e p.1, e p.2)) (𝓤 β),
  from he₁.comap_uniformity.symm ▸ hs,
let ⟨t₁, ht₁u, ht₁⟩ := this in
have ht₁ : ∀p:α×α, (e p.1, e p.2) ∈ t₁ → p ∈ s, from ht₁,
let ⟨t₂, ht₂u, ht₂s, ht₂c⟩ := comp_symm_of_uniformity ht₁u in
let ⟨t, htu, hts, htc⟩ := comp_symm_of_uniformity ht₂u in
have preimage e {b' | (b, b') ∈ t₂} ∈ comap e (𝓝 b),
  from preimage_mem_comap $ mem_nhds_left b ht₂u,
let ⟨a, (ha : (b, e a) ∈ t₂)⟩ := (he₂.comap_nhds_ne_bot _).nonempty_of_mem this in
have ∀b' (s' : set (β × β)), (b, b') ∈ t → s' ∈ 𝓤 β →
  ({y : β | (b', y) ∈ s'} ∩ e '' {a' : α | (a, a') ∈ s}).nonempty,
  from assume b' s' hb' hs',
  have preimage e {b'' | (b', b'') ∈ s' ∩ t} ∈ comap e (𝓝 b'),
    from preimage_mem_comap $ mem_nhds_left b' $ inter_mem_sets hs' htu,
  let ⟨a₂, ha₂s', ha₂t⟩ := (he₂.comap_nhds_ne_bot _).nonempty_of_mem this in
  have (e a, e a₂) ∈ t₁,
    from ht₂c $ prod_mk_mem_comp_rel (ht₂s ha) $ htc $ prod_mk_mem_comp_rel hb' ha₂t,
  have e a₂ ∈ {b'':β | (b', b'') ∈ s'} ∩ e '' {a' | (a, a') ∈ s},
    from ⟨ha₂s', mem_image_of_mem _ $ ht₁ (a, a₂) this⟩,
  ⟨_, this⟩,
have ∀b', (b, b') ∈ t → ne_bot (𝓝 b' ⊓ 𝓟 (e '' {a' | (a, a') ∈ s})),
begin
  intros b' hb',
  rw [nhds_eq_uniformity, lift'_inf_principal_eq, lift'_ne_bot_iff],
  exact assume s, this b' s hb',
  exact monotone_inter monotone_preimage monotone_const
end,
have ∀b', (b, b') ∈ t → b' ∈ closure (e '' {a' | (a, a') ∈ s}),
  from assume b' hb', by rw [closure_eq_cluster_pts]; exact this b' hb',
⟨a, (𝓝 b).sets_of_superset (mem_nhds_left b htu) this⟩

lemma uniform_embedding_subtype_emb (p : α → Prop) {e : α → β} (ue : uniform_embedding e)
  (de : dense_embedding e) : uniform_embedding (dense_embedding.subtype_emb p e) :=
{ comap_uniformity := by simp [comap_comap, (∘), dense_embedding.subtype_emb,
           uniformity_subtype, ue.comap_uniformity.symm],
  inj := (de.subtype p).inj }

lemma uniform_embedding.prod {α' : Type*} {β' : Type*} [uniform_space α'] [uniform_space β']
  {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_embedding e₁) (h₂ : uniform_embedding e₂) :
  uniform_embedding (λp:α×β, (e₁ p.1, e₂ p.2)) :=
{ inj := h₁.inj.prod_map h₂.inj,
  ..h₁.to_uniform_inducing.prod h₂.to_uniform_inducing }

lemma is_complete_of_complete_image {m : α → β} {s : set α} (hm : uniform_inducing m)
  (hs : is_complete (m '' s)) : is_complete s :=
begin
  intros f hf hfs,
  rw le_principal_iff at hfs,
  obtain ⟨_, ⟨x, hx, rfl⟩, hyf⟩ : ∃ y ∈ m '' s, map m f ≤ 𝓝 y,
    from hs (f.map m) (hf.map hm.uniform_continuous)
      (le_principal_iff.2 (image_mem_map hfs)),
  rw [map_le_iff_le_comap, ← nhds_induced, ← hm.inducing.induced] at hyf,
  exact ⟨x, hx, hyf⟩
end

lemma is_complete.complete_space_coe {s : set α} (hs : is_complete s) :
  complete_space s :=
complete_space_iff_is_complete_univ.2 $
  is_complete_of_complete_image uniform_embedding_subtype_coe.to_uniform_inducing $ by simp [hs]

/-- A set is complete iff its image under a uniform inducing map is complete. -/
lemma is_complete_image_iff {m : α → β} {s : set α} (hm : uniform_inducing m) :
  is_complete (m '' s) ↔ is_complete s :=
begin
  refine ⟨is_complete_of_complete_image hm, λ c, _⟩,
  haveI : complete_space s := c.complete_space_coe,
  set m' : s → β := m ∘ coe,
  suffices : is_complete (range m'), by rwa [range_comp, subtype.range_coe] at this,
  have hm' : uniform_inducing m' := hm.comp uniform_embedding_subtype_coe.to_uniform_inducing,
  intros f hf hfm,
  rw filter.le_principal_iff at hfm,
  have cf' : cauchy (comap m' f) :=
    hf.comap' hm'.comap_uniformity.le (ne_bot.comap_of_range_mem hf.1 hfm),
  rcases complete_space.complete cf' with ⟨x, hx⟩,
  rw [hm'.inducing.nhds_eq_comap, comap_le_comap_iff hfm] at hx,
  use [m' x, mem_range_self _, hx]
end

lemma complete_space_iff_is_complete_range {f : α → β} (hf : uniform_inducing f) :
  complete_space α ↔ is_complete (range f) :=
by rw [complete_space_iff_is_complete_univ, ← is_complete_image_iff hf, image_univ]

lemma uniform_inducing.is_complete_range [complete_space α] {f : α → β}
  (hf : uniform_inducing f) :
  is_complete (range f) :=
(complete_space_iff_is_complete_range hf).1 ‹_›

lemma complete_space_congr {e : α ≃ β} (he : uniform_embedding e) :
  complete_space α ↔ complete_space β :=
by rw [complete_space_iff_is_complete_range he.to_uniform_inducing, e.range_eq_univ,
  complete_space_iff_is_complete_univ]

lemma complete_space_coe_iff_is_complete {s : set α} :
  complete_space s ↔ is_complete s :=
(complete_space_iff_is_complete_range uniform_embedding_subtype_coe.to_uniform_inducing).trans $
  by rw [subtype.range_coe]

lemma is_closed.complete_space_coe [complete_space α] {s : set α} (hs : is_closed s) :
  complete_space s :=
hs.is_complete.complete_space_coe

lemma complete_space_extension {m : β → α} (hm : uniform_inducing m) (dense : dense_range m)
  (h : ∀f:filter β, cauchy f → ∃x:α, map m f ≤ 𝓝 x) : complete_space α :=
⟨assume (f : filter α), assume hf : cauchy f,
let
  p : set (α × α) → set α → set α := λs t, {y : α| ∃x:α, x ∈ t ∧ (x, y) ∈ s},
  g := (𝓤 α).lift (λs, f.lift' (p s))
in
have mp₀ : monotone p,
  from assume a b h t s ⟨x, xs, xa⟩, ⟨x, xs, h xa⟩,
have mp₁ : ∀{s}, monotone (p s),
  from assume s a b h x ⟨y, ya, yxs⟩, ⟨y, h ya, yxs⟩,

have f ≤ g, from
  le_infi $ assume s, le_infi $ assume hs, le_infi $ assume t, le_infi $ assume ht,
  le_principal_iff.mpr $
  mem_sets_of_superset ht $ assume x hx, ⟨x, hx, refl_mem_uniformity hs⟩,

have ne_bot g, from hf.left.mono this,

have ne_bot (comap m g), from comap_ne_bot $ assume t ht,
  let ⟨t', ht', ht_mem⟩ := (mem_lift_sets $ monotone_lift' monotone_const mp₀).mp ht in
  let ⟨t'', ht'', ht'_sub⟩ := (mem_lift'_sets mp₁).mp ht_mem in
  let ⟨x, (hx : x ∈ t'')⟩ := hf.left.nonempty_of_mem ht'' in
  have h₀ : ne_bot (𝓝[range m] x),
    from dense.nhds_within_ne_bot x,
  have h₁ : {y | (x, y) ∈ t'} ∈ 𝓝[range m] x,
    from @mem_inf_sets_of_left α (𝓝 x) (𝓟 (range m)) _ $ mem_nhds_left x ht',
  have h₂ : range m ∈ 𝓝[range m] x,
    from @mem_inf_sets_of_right α (𝓝 x) (𝓟 (range m)) _ $ subset.refl _,
  have {y | (x, y) ∈ t'} ∩ range m ∈ 𝓝[range m] x,
    from @inter_mem_sets α (𝓝[range m] x) _ _ h₁ h₂,
  let ⟨y, xyt', b, b_eq⟩ := h₀.nonempty_of_mem this in
  ⟨b, b_eq.symm ▸ ht'_sub ⟨x, hx, xyt'⟩⟩,

have cauchy g, from
  ⟨‹ne_bot g›, assume s hs,
  let
    ⟨s₁, hs₁, (comp_s₁ : comp_rel s₁ s₁ ⊆ s)⟩ := comp_mem_uniformity_sets hs,
    ⟨s₂, hs₂, (comp_s₂ : comp_rel s₂ s₂ ⊆ s₁)⟩ := comp_mem_uniformity_sets hs₁,
    ⟨t, ht, (prod_t : set.prod t t ⊆ s₂)⟩ := mem_prod_same_iff.mp (hf.right hs₂)
  in
  have hg₁ : p (preimage prod.swap s₁) t ∈ g,
    from mem_lift (symm_le_uniformity hs₁) $ @mem_lift' α α f _ t ht,
  have hg₂ : p s₂ t ∈ g,
    from mem_lift hs₂ $ @mem_lift' α α f _ t ht,
  have hg : set.prod (p (preimage prod.swap s₁) t) (p s₂ t) ∈ g ×ᶠ g,
    from @prod_mem_prod α α _ _ g g hg₁ hg₂,
  (g ×ᶠ g).sets_of_superset hg
    (assume ⟨a, b⟩ ⟨⟨c₁, c₁t, hc₁⟩, ⟨c₂, c₂t, hc₂⟩⟩,
      have (c₁, c₂) ∈ set.prod t t, from ⟨c₁t, c₂t⟩,
      comp_s₁ $ prod_mk_mem_comp_rel hc₁ $
      comp_s₂ $ prod_mk_mem_comp_rel (prod_t this) hc₂)⟩,

have cauchy (filter.comap m g),
  from ‹cauchy g›.comap' (le_of_eq hm.comap_uniformity) ‹_›,

let ⟨x, (hx : map m (filter.comap m g) ≤ 𝓝 x)⟩ := h _ this in
have cluster_pt x (map m (filter.comap m g)),
  from (le_nhds_iff_adhp_of_cauchy (this.map hm.uniform_continuous)).mp hx,
have cluster_pt x g,
  from  this.mono map_comap_le,

⟨x, calc f ≤ g : by assumption
  ... ≤ 𝓝 x : le_nhds_of_cauchy_adhp ‹cauchy g› this⟩⟩

lemma totally_bounded_preimage {f : α → β} {s : set β} (hf : uniform_embedding f)
  (hs : totally_bounded s) : totally_bounded (f ⁻¹' s) :=
λ t ht, begin
  rw ← hf.comap_uniformity at ht,
  rcases mem_comap_sets.2 ht with ⟨t', ht', ts⟩,
  rcases totally_bounded_iff_subset.1
    (totally_bounded_subset (image_preimage_subset f s) hs) _ ht' with ⟨c, cs, hfc, hct⟩,
  refine ⟨f ⁻¹' c, hfc.preimage (hf.inj.inj_on _), λ x h, _⟩,
  have := hct (mem_image_of_mem f h), simp at this ⊢,
  rcases this with ⟨z, zc, zt⟩,
  rcases cs zc with ⟨y, yc, rfl⟩,
  exact ⟨y, zc, ts (by exact zt)⟩
end

end

lemma uniform_embedding_comap {α : Type*} {β : Type*} {f : α → β} [u : uniform_space β]
  (hf : function.injective f) : @uniform_embedding α β (uniform_space.comap f u) u f :=
@uniform_embedding.mk _ _ (uniform_space.comap f u) _ _
  (@uniform_inducing.mk _ _ (uniform_space.comap f u) _ _ rfl) hf

section uniform_extension

variables {α : Type*} {β : Type*} {γ : Type*}
          [uniform_space α] [uniform_space β] [uniform_space γ]
          {e : β → α}
          (h_e : uniform_inducing e)
          (h_dense : dense_range e)
          {f : β → γ}
          (h_f : uniform_continuous f)

local notation `ψ` := (h_e.dense_inducing h_dense).extend f

lemma uniformly_extend_exists [complete_space γ] (a : α) :
  ∃c, tendsto f (comap e (𝓝 a)) (𝓝 c) :=
let de := (h_e.dense_inducing h_dense) in
have cauchy (𝓝 a), from cauchy_nhds,
have cauchy (comap e (𝓝 a)), from
  this.comap' (le_of_eq h_e.comap_uniformity) (de.comap_nhds_ne_bot _),
have cauchy (map f (comap e (𝓝 a))), from this.map h_f,
complete_space.complete this

lemma uniform_extend_subtype [complete_space γ]
  {p : α → Prop} {e : α → β} {f : α → γ} {b : β} {s : set α}
  (hf : uniform_continuous (λx:subtype p, f x.val))
  (he : uniform_embedding e) (hd : ∀x:β, x ∈ closure (range e))
  (hb : closure (e '' s) ∈ 𝓝 b) (hs : is_closed s) (hp : ∀x∈s, p x) :
  ∃c, tendsto f (comap e (𝓝 b)) (𝓝 c) :=
have de : dense_embedding e,
  from he.dense_embedding hd,
have de' : dense_embedding (dense_embedding.subtype_emb p e),
  by exact de.subtype p,
have ue' : uniform_embedding (dense_embedding.subtype_emb p e),
  from uniform_embedding_subtype_emb _ he de,
have b ∈ closure (e '' {x | p x}),
  from (closure_mono $ monotone_image $ hp) (mem_of_nhds hb),
let ⟨c, (hc : tendsto (f ∘ subtype.val)
     (comap (dense_embedding.subtype_emb p e) (𝓝 ⟨b, this⟩)) (𝓝 c))⟩ :=
  uniformly_extend_exists ue'.to_uniform_inducing de'.dense hf _ in
begin
  rw [nhds_subtype_eq_comap] at hc,
  simp [comap_comap] at hc,
  change (tendsto (f ∘ @subtype.val α p) (comap (e ∘ @subtype.val α p) (𝓝 b)) (𝓝 c)) at hc,
  rw [←comap_comap, tendsto_comap'_iff] at hc,
  exact ⟨c, hc⟩,
  exact ⟨_, hb, assume x,
    begin
      change e x ∈ (closure (e '' s)) → x ∈ range subtype.val,
      rw [← closure_induced, mem_closure_iff_cluster_pt, cluster_pt, ne_bot_iff,
          nhds_induced, ← de.to_dense_inducing.nhds_eq_comap,
          ← mem_closure_iff_nhds_ne_bot, hs.closure_eq],
      exact assume hxs, ⟨⟨x, hp x hxs⟩, rfl⟩,
    end⟩
end

variables [separated_space γ]

lemma uniformly_extend_of_ind (b : β) : ψ (e b) = f b :=
dense_inducing.extend_eq_at _ b h_f.continuous.continuous_at

lemma uniformly_extend_unique {g : α → γ} (hg : ∀ b, g (e b) = f b)
  (hc : continuous g) :
  ψ = g :=
dense_inducing.extend_unique _ hg hc

include h_f

lemma uniformly_extend_spec [complete_space γ] (a : α) :
  tendsto f (comap e (𝓝 a)) (𝓝 (ψ a)) :=
let de := (h_e.dense_inducing h_dense) in
begin
  by_cases ha : a ∈ range e,
  { rcases ha with ⟨b, rfl⟩,
    rw [uniformly_extend_of_ind _ _ h_f, ← de.nhds_eq_comap],
    exact h_f.continuous.tendsto _ },
  { simp only [dense_inducing.extend, dif_neg ha],
    exact tendsto_nhds_lim (uniformly_extend_exists h_e h_dense h_f _) }
end

lemma uniform_continuous_uniformly_extend [cγ : complete_space γ] : uniform_continuous ψ :=
assume d hd,
let ⟨s, hs, hs_comp⟩ := (mem_lift'_sets $
  monotone_comp_rel monotone_id $ monotone_comp_rel monotone_id monotone_id).mp
    (comp_le_uniformity3 hd) in
have h_pnt : ∀{a m}, m ∈ 𝓝 a → ∃c, c ∈ f '' preimage e m ∧ (c, ψ a) ∈ s ∧ (ψ a, c) ∈ s,
  from assume a m hm,
  have nb : ne_bot (map f (comap e (𝓝 a))),
    from ((h_e.dense_inducing h_dense).comap_nhds_ne_bot _).map _,
  have (f '' preimage e m) ∩ ({c | (c, ψ a) ∈ s } ∩ {c | (ψ a, c) ∈ s }) ∈ map f (comap e (𝓝 a)),
    from inter_mem_sets (image_mem_map $ preimage_mem_comap $ hm)
      (uniformly_extend_spec h_e h_dense h_f _
        (inter_mem_sets (mem_nhds_right _ hs) (mem_nhds_left _ hs))),
  nb.nonempty_of_mem this,
have preimage (λp:β×β, (f p.1, f p.2)) s ∈ 𝓤 β,
  from h_f hs,
have preimage (λp:β×β, (f p.1, f p.2)) s ∈ comap (λx:β×β, (e x.1, e x.2)) (𝓤 α),
  by rwa [h_e.comap_uniformity.symm] at this,
let ⟨t, ht, ts⟩ := this in
show preimage (λp:(α×α), (ψ p.1, ψ p.2)) d ∈ 𝓤 α,
  from (𝓤 α).sets_of_superset (interior_mem_uniformity ht) $
  assume ⟨x₁, x₂⟩ hx_t,
  have 𝓝 (x₁, x₂) ≤ 𝓟 (interior t),
    from is_open_iff_nhds.mp is_open_interior (x₁, x₂) hx_t,
  have interior t ∈ 𝓝 x₁ ×ᶠ 𝓝 x₂,
    by rwa [nhds_prod_eq, le_principal_iff] at this,
  let ⟨m₁, hm₁, m₂, hm₂, (hm : set.prod m₁ m₂ ⊆ interior t)⟩ := mem_prod_iff.mp this in
  let ⟨a, ha₁, _, ha₂⟩ := h_pnt hm₁ in
  let ⟨b, hb₁, hb₂, _⟩ := h_pnt hm₂ in
  have set.prod (preimage e m₁) (preimage e m₂) ⊆ preimage (λp:(β×β), (f p.1, f p.2)) s,
    from calc _ ⊆ preimage (λp:(β×β), (e p.1, e p.2)) (interior t) : preimage_mono hm
    ... ⊆ preimage (λp:(β×β), (e p.1, e p.2)) t : preimage_mono interior_subset
    ... ⊆ preimage (λp:(β×β), (f p.1, f p.2)) s : ts,
  have set.prod (f '' preimage e m₁) (f '' preimage e m₂) ⊆ s,
    from calc set.prod (f '' preimage e m₁) (f '' preimage e m₂) =
      (λp:(β×β), (f p.1, f p.2)) '' (set.prod (preimage e m₁) (preimage e m₂)) : prod_image_image_eq
    ... ⊆ (λp:(β×β), (f p.1, f p.2)) '' preimage (λp:(β×β), (f p.1, f p.2)) s : monotone_image this
    ... ⊆ s : image_subset_iff.mpr $ subset.refl _,
  have (a, b) ∈ s, from @this (a, b) ⟨ha₁, hb₁⟩,
  hs_comp $ show (ψ x₁, ψ x₂) ∈ comp_rel s (comp_rel s s),
    from ⟨a, ha₂, ⟨b, this, hb₂⟩⟩
end uniform_extension


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.finset.sort
import Mathlib.group_theory.perm.basic
import Mathlib.group_theory.order_of_element
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

/-!
# Sign of a permutation

The main definition of this file is `equiv.perm.sign`, associating a `units ℤ` sign with a
permutation.

This file also contains miscellaneous lemmas about `equiv.perm` and `equiv.swap`, building on top
of those in `data/equiv/basic` and `data/equiv/perm`.

-/

namespace equiv.perm

/--
`mod_swap i j` contains permutations up to swapping `i` and `j`.

We use this to partition permutations in `matrix.det_zero_of_row_eq`, such that each partition
sums up to `0`.
-/
def mod_swap {α : Type u} [DecidableEq α] (i : α) (j : α) : setoid (perm α) :=
  setoid.mk (fun (σ τ : perm α) => σ = τ ∨ σ = swap i j * τ) sorry

protected instance r.decidable_rel {α : Type u_1} [fintype α] [DecidableEq α] (i : α) (j : α) :
    DecidableRel setoid.r :=
  fun (σ τ : perm α) => or.decidable

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm {α : Type u} (f : perm α) {p : α → Prop} (h : ∀ (x : α), p x ↔ p (coe_fn f x)) :
    perm (Subtype fun (x : α) => p x) :=
  mk (fun (x : Subtype fun (x : α) => p x) => { val := coe_fn f ↑x, property := sorry })
    (fun (x : Subtype fun (x : α) => p x) => { val := coe_fn (f⁻¹) ↑x, property := sorry }) sorry
    sorry

@[simp] theorem subtype_perm_one {α : Type u} (p : α → Prop) (h : ∀ (x : α), p x ↔ p (coe_fn 1 x)) :
    subtype_perm 1 h = 1 :=
  sorry

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype {α : Type u} {p : α → Prop} [decidable_pred p] : perm (Subtype p) →* perm α :=
  monoid_hom.mk
    (fun (f : perm (Subtype p)) =>
      mk
        (fun (x : α) =>
          dite (p x) (fun (h : p x) => ↑(coe_fn f { val := x, property := h })) fun (h : ¬p x) => x)
        (fun (x : α) =>
          dite (p x) (fun (h : p x) => ↑(coe_fn (f⁻¹) { val := x, property := h }))
            fun (h : ¬p x) => x)
        sorry sorry)
    sorry sorry

/-- Two permutations `f` and `g` are `disjoint` if their supports are disjoint, i.e.,
every element is fixed either by `f`, or by `g`. -/
def disjoint {α : Type u} (f : perm α) (g : perm α) := ∀ (x : α), coe_fn f x = x ∨ coe_fn g x = x

theorem disjoint.symm {α : Type u} {f : perm α} {g : perm α} : disjoint f g → disjoint g f := sorry

theorem disjoint_comm {α : Type u} {f : perm α} {g : perm α} : disjoint f g ↔ disjoint g f :=
  { mp := disjoint.symm, mpr := disjoint.symm }

theorem disjoint.mul_comm {α : Type u} {f : perm α} {g : perm α} (h : disjoint f g) :
    f * g = g * f :=
  sorry

@[simp] theorem disjoint_one_left {α : Type u} (f : perm α) : disjoint 1 f :=
  fun (_x : α) => Or.inl rfl

@[simp] theorem disjoint_one_right {α : Type u} (f : perm α) : disjoint f 1 :=
  fun (_x : α) => Or.inr rfl

theorem disjoint.mul_left {α : Type u} {f : perm α} {g : perm α} {h : perm α} (H1 : disjoint f h)
    (H2 : disjoint g h) : disjoint (f * g) h :=
  sorry

theorem disjoint.mul_right {α : Type u} {f : perm α} {g : perm α} {h : perm α} (H1 : disjoint f g)
    (H2 : disjoint f h) : disjoint f (g * h) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (disjoint f (g * h))) (propext disjoint_comm)))
    (disjoint.mul_left (disjoint.symm H1) (disjoint.symm H2))

theorem disjoint_prod_right {α : Type u} {f : perm α} (l : List (perm α))
    (h : ∀ (g : perm α), g ∈ l → disjoint f g) : disjoint f (list.prod l) :=
  sorry

theorem disjoint_prod_perm {α : Type u} {l₁ : List (perm α)} {l₂ : List (perm α)}
    (hl : list.pairwise disjoint l₁) (hp : l₁ ~ l₂) : list.prod l₁ = list.prod l₂ :=
  list.perm.prod_eq' hp (list.pairwise.imp (fun (f g : perm α) => disjoint.mul_comm) hl)

theorem of_subtype_subtype_perm {α : Type u} {f : perm α} {p : α → Prop} [decidable_pred p]
    (h₁ : ∀ (x : α), p x ↔ p (coe_fn f x)) (h₂ : ∀ (x : α), coe_fn f x ≠ x → p x) :
    coe_fn of_subtype (subtype_perm f h₁) = f :=
  sorry

theorem of_subtype_apply_of_not_mem {α : Type u} {p : α → Prop} [decidable_pred p]
    (f : perm (Subtype p)) {x : α} (hx : ¬p x) : coe_fn (coe_fn of_subtype f) x = x :=
  dif_neg hx

theorem mem_iff_of_subtype_apply_mem {α : Type u} {p : α → Prop} [decidable_pred p]
    (f : perm (Subtype p)) (x : α) : p x ↔ p (coe_fn (coe_fn of_subtype f) x) :=
  sorry

@[simp] theorem subtype_perm_of_subtype {α : Type u} {p : α → Prop} [decidable_pred p]
    (f : perm (Subtype p)) :
    subtype_perm (coe_fn of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
  sorry

theorem pow_apply_eq_self_of_apply_eq_self {α : Type u} {f : perm α} {x : α} (hfx : coe_fn f x = x)
    (n : ℕ) : coe_fn (f ^ n) x = x :=
  sorry

theorem gpow_apply_eq_self_of_apply_eq_self {α : Type u} {f : perm α} {x : α} (hfx : coe_fn f x = x)
    (n : ℤ) : coe_fn (f ^ n) x = x :=
  sorry

theorem pow_apply_eq_of_apply_apply_eq_self {α : Type u} {f : perm α} {x : α}
    (hffx : coe_fn f (coe_fn f x) = x) (n : ℕ) :
    coe_fn (f ^ n) x = x ∨ coe_fn (f ^ n) x = coe_fn f x :=
  sorry

theorem gpow_apply_eq_of_apply_apply_eq_self {α : Type u} {f : perm α} {x : α}
    (hffx : coe_fn f (coe_fn f x) = x) (i : ℤ) :
    coe_fn (f ^ i) x = x ∨ coe_fn (f ^ i) x = coe_fn f x :=
  sorry

/-- The `finset` of nonfixed points of a permutation. -/
def support {α : Type u} [DecidableEq α] [fintype α] (f : perm α) : finset α :=
  finset.filter (fun (x : α) => coe_fn f x ≠ x) finset.univ

@[simp] theorem mem_support {α : Type u} [DecidableEq α] [fintype α] {f : perm α} {x : α} :
    x ∈ support f ↔ coe_fn f x ≠ x :=
  sorry

/-- `f.is_swap` indicates that the permutation `f` is a transposition of two elements. -/
def is_swap {α : Type u} [DecidableEq α] (f : perm α) := ∃ (x : α), ∃ (y : α), x ≠ y ∧ f = swap x y

theorem is_swap.of_subtype_is_swap {α : Type u} [DecidableEq α] {p : α → Prop} [decidable_pred p]
    {f : perm (Subtype p)} (h : is_swap f) : is_swap (coe_fn of_subtype f) :=
  sorry

theorem ne_and_ne_of_swap_mul_apply_ne_self {α : Type u} [DecidableEq α] {f : perm α} {x : α}
    {y : α} (hy : coe_fn (swap x (coe_fn f x) * f) y ≠ y) : coe_fn f y ≠ y ∧ y ≠ x :=
  sorry

theorem support_swap_mul_eq {α : Type u} [DecidableEq α] [fintype α] {f : perm α} {x : α}
    (hffx : coe_fn f (coe_fn f x) ≠ x) :
    support (swap x (coe_fn f x) * f) = finset.erase (support f) x :=
  sorry

theorem card_support_swap_mul {α : Type u} [DecidableEq α] [fintype α] {f : perm α} {x : α}
    (hx : coe_fn f x ≠ x) :
    finset.card (support (swap x (coe_fn f x) * f)) < finset.card (support f) :=
  sorry

/-- Given a list `l : list α` and a permutation `f : perm α` such that the nonfixed points of `f`
  are in `l`, recursively factors `f` as a product of transpositions. -/
def swap_factors_aux {α : Type u} [DecidableEq α] (l : List α) (f : perm α) :
    (∀ {x : α}, coe_fn f x ≠ x → x ∈ l) →
        Subtype fun (l : List (perm α)) => list.prod l = f ∧ ∀ (g : perm α), g ∈ l → is_swap g :=
  sorry

/-- `swap_factors` represents a permutation as a product of a list of transpositions.
The representation is non unique and depends on the linear order structure.
For types without linear order `trunc_swap_factors` can be used. -/
def swap_factors {α : Type u} [DecidableEq α] [fintype α] [linear_order α] (f : perm α) :
    Subtype fun (l : List (perm α)) => list.prod l = f ∧ ∀ (g : perm α), g ∈ l → is_swap g :=
  swap_factors_aux (finset.sort LessEq finset.univ) f sorry

/-- This computably represents the fact that any permutation can be represented as the product of
  a list of transpositions. -/
def trunc_swap_factors {α : Type u} [DecidableEq α] [fintype α] (f : perm α) :
    trunc
        (Subtype fun (l : List (perm α)) => list.prod l = f ∧ ∀ (g : perm α), g ∈ l → is_swap g) :=
  quotient.rec_on_subsingleton (finset.val finset.univ)
    (fun (l : List α) (h : ∀ (x : α), coe_fn f x ≠ x → x ∈ quotient.mk l) =>
      trunc.mk (swap_factors_aux l f h))
    sorry

/-- An induction principle for permutations. If `P` holds for the identity permutation, and
is preserved under composition with a non-trivial swap, then `P` holds for all permutations. -/
theorem swap_induction_on {α : Type u} [DecidableEq α] [fintype α] {P : perm α → Prop}
    (f : perm α) : P 1 → (∀ (f : perm α) (x y : α), x ≠ y → P f → P (swap x y * f)) → P f :=
  sorry

/-- Like `swap_induction_on`, but with the composition on the right of `f`.

An induction principle for permutations. If `P` holds for the identity permutation, and
is preserved under composition with a non-trivial swap, then `P` holds for all permutations. -/
theorem swap_induction_on' {α : Type u} [DecidableEq α] [fintype α] {P : perm α → Prop}
    (f : perm α) : P 1 → (∀ (f : perm α) (x y : α), x ≠ y → P f → P (f * swap x y)) → P f :=
  fun (h1 : P 1) (IH : ∀ (f : perm α) (x y : α), x ≠ y → P f → P (f * swap x y)) =>
    inv_inv f ▸ swap_induction_on (f⁻¹) h1 fun (f : perm α) => IH (f⁻¹)

theorem is_conj_swap {α : Type u} [DecidableEq α] {w : α} {x : α} {y : α} {z : α} (hwx : w ≠ x)
    (hyz : y ≠ z) : is_conj (swap w x) (swap y z) :=
  sorry

/-- set of all pairs (⟨a, b⟩ : Σ a : fin n, fin n) such that b < a -/
def fin_pairs_lt (n : ℕ) : finset (sigma fun (a : fin n) => fin n) :=
  finset.sigma finset.univ fun (a : fin n) => finset.attach_fin (finset.range ↑a) sorry

theorem mem_fin_pairs_lt {n : ℕ} {a : sigma fun (a : fin n) => fin n} :
    a ∈ fin_pairs_lt n ↔ sigma.snd a < sigma.fst a :=
  sorry

/-- `sign_aux σ` is the sign of a permutation on `fin n`, defined as the parity of the number of
  pairs `(x₁, x₂)` such that `x₂ < x₁` but `σ x₁ ≤ σ x₂` -/
def sign_aux {n : ℕ} (a : perm (fin n)) : units ℤ :=
  finset.prod (fin_pairs_lt n)
    fun (x : sigma fun (a : fin n) => fin n) =>
      ite (coe_fn a (sigma.fst x) ≤ coe_fn a (sigma.snd x)) (-1) 1

@[simp] theorem sign_aux_one (n : ℕ) : sign_aux 1 = 1 := sorry

/-- `sign_bij_aux f ⟨a, b⟩` returns the pair consisting of `f a` and `f b` in decreasing order. -/
def sign_bij_aux {n : ℕ} (f : perm (fin n)) (a : sigma fun (a : fin n) => fin n) :
    sigma fun (a : fin n) => fin n :=
  dite (coe_fn f (sigma.snd a) < coe_fn f (sigma.fst a))
    (fun (hxa : coe_fn f (sigma.snd a) < coe_fn f (sigma.fst a)) =>
      sigma.mk (coe_fn f (sigma.fst a)) (coe_fn f (sigma.snd a)))
    fun (hxa : ¬coe_fn f (sigma.snd a) < coe_fn f (sigma.fst a)) =>
      sigma.mk (coe_fn f (sigma.snd a)) (coe_fn f (sigma.fst a))

theorem sign_bij_aux_inj {n : ℕ} {f : perm (fin n)} (a : sigma fun (a : fin n) => fin n)
    (b : sigma fun (a : fin n) => fin n) :
    a ∈ fin_pairs_lt n → b ∈ fin_pairs_lt n → sign_bij_aux f a = sign_bij_aux f b → a = b :=
  sorry

theorem sign_bij_aux_surj {n : ℕ} {f : perm (fin n)} (a : sigma fun (a : fin n) => fin n)
    (H : a ∈ fin_pairs_lt n) :
    ∃ (b : sigma fun (a : fin n) => fin n), ∃ (H : b ∈ fin_pairs_lt n), a = sign_bij_aux f b :=
  sorry

theorem sign_bij_aux_mem {n : ℕ} {f : perm (fin n)} (a : sigma fun (a : fin n) => fin n) :
    a ∈ fin_pairs_lt n → sign_bij_aux f a ∈ fin_pairs_lt n :=
  sorry

@[simp] theorem sign_aux_inv {n : ℕ} (f : perm (fin n)) : sign_aux (f⁻¹) = sign_aux f := sorry

theorem sign_aux_mul {n : ℕ} (f : perm (fin n)) (g : perm (fin n)) :
    sign_aux (f * g) = sign_aux f * sign_aux g :=
  sorry

-- TODO: slow

theorem sign_aux_swap {n : ℕ} {x : fin n} {y : fin n} (hxy : x ≠ y) : sign_aux (swap x y) = -1 :=
  sorry

/-- When the list `l : list α` contains all nonfixed points of the permutation `f : perm α`,
  `sign_aux2 l f` recursively calculates the sign of `f`. -/
def sign_aux2 {α : Type u} [DecidableEq α] : List α → perm α → units ℤ := sorry

theorem sign_aux_eq_sign_aux2 {α : Type u} [DecidableEq α] {n : ℕ} (l : List α) (f : perm α)
    (e : α ≃ fin n) (h : ∀ (x : α), coe_fn f x ≠ x → x ∈ l) :
    sign_aux (equiv.trans (equiv.trans (equiv.symm e) f) e) = sign_aux2 l f :=
  sorry

/-- When the multiset `s : multiset α` contains all nonfixed points of the permutation `f : perm α`,
  `sign_aux2 f _` recursively calculates the sign of `f`. -/
def sign_aux3 {α : Type u} [DecidableEq α] [fintype α] (f : perm α) {s : multiset α} :
    (∀ (x : α), x ∈ s) → units ℤ :=
  quotient.hrec_on s (fun (l : List α) (h : ∀ (x : α), x ∈ quotient.mk l) => sign_aux2 l f) sorry

theorem sign_aux3_mul_and_swap {α : Type u} [DecidableEq α] [fintype α] (f : perm α) (g : perm α)
    (s : multiset α) (hs : ∀ (x : α), x ∈ s) :
    sign_aux3 (f * g) hs = sign_aux3 f hs * sign_aux3 g hs ∧
        ∀ (x y : α), x ≠ y → sign_aux3 (swap x y) hs = -1 :=
  sorry

/-- `sign` of a permutation returns the signature or parity of a permutation, `1` for even
permutations, `-1` for odd permutations. It is the unique surjective group homomorphism from
`perm α` to the group with two elements.-/
def sign {α : Type u} [DecidableEq α] [fintype α] : perm α →* units ℤ :=
  monoid_hom.mk' (fun (f : perm α) => sign_aux3 f finset.mem_univ) sorry

@[simp] theorem sign_mul {α : Type u} [DecidableEq α] [fintype α] (f : perm α) (g : perm α) :
    coe_fn sign (f * g) = coe_fn sign f * coe_fn sign g :=
  monoid_hom.map_mul sign f g

@[simp] theorem sign_trans {α : Type u} [DecidableEq α] [fintype α] (f : perm α) (g : perm α) :
    coe_fn sign (equiv.trans f g) = coe_fn sign g * coe_fn sign f :=
  sorry

@[simp] theorem sign_one {α : Type u} [DecidableEq α] [fintype α] : coe_fn sign 1 = 1 :=
  monoid_hom.map_one sign

@[simp] theorem sign_refl {α : Type u} [DecidableEq α] [fintype α] :
    coe_fn sign (equiv.refl α) = 1 :=
  monoid_hom.map_one sign

@[simp] theorem sign_inv {α : Type u} [DecidableEq α] [fintype α] (f : perm α) :
    coe_fn sign (f⁻¹) = coe_fn sign f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn sign (f⁻¹) = coe_fn sign f)) (monoid_hom.map_inv sign f)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (coe_fn sign f⁻¹ = coe_fn sign f))
          (int.units_inv_eq_self (coe_fn sign f))))
      (Eq.refl (coe_fn sign f)))

@[simp] theorem sign_symm {α : Type u} [DecidableEq α] [fintype α] (e : perm α) :
    coe_fn sign (equiv.symm e) = coe_fn sign e :=
  sign_inv e

theorem sign_swap {α : Type u} [DecidableEq α] [fintype α] {x : α} {y : α} (h : x ≠ y) :
    coe_fn sign (swap x y) = -1 :=
  and.right (sign_aux3_mul_and_swap 1 1 (finset.val finset.univ) finset.mem_univ) x y h

@[simp] theorem sign_swap' {α : Type u} [DecidableEq α] [fintype α] {x : α} {y : α} :
    coe_fn sign (swap x y) = ite (x = y) 1 (-1) :=
  sorry

theorem is_swap.sign_eq {α : Type u} [DecidableEq α] [fintype α] {f : perm α} (h : is_swap f) :
    coe_fn sign f = -1 :=
  sorry

theorem sign_aux3_symm_trans_trans {α : Type u} {β : Type v} [DecidableEq α] [fintype α]
    [DecidableEq β] [fintype β] (f : perm α) (e : α ≃ β) {s : multiset α} {t : multiset β}
    (hs : ∀ (x : α), x ∈ s) (ht : ∀ (x : β), x ∈ t) :
    sign_aux3 (equiv.trans (equiv.trans (equiv.symm e) f) e) ht = sign_aux3 f hs :=
  sorry

@[simp] theorem sign_symm_trans_trans {α : Type u} {β : Type v} [DecidableEq α] [fintype α]
    [DecidableEq β] [fintype β] (f : perm α) (e : α ≃ β) :
    coe_fn sign (equiv.trans (equiv.trans (equiv.symm e) f) e) = coe_fn sign f :=
  sign_aux3_symm_trans_trans f e finset.mem_univ finset.mem_univ

@[simp] theorem sign_trans_trans_symm {α : Type u} {β : Type v} [DecidableEq α] [fintype α]
    [DecidableEq β] [fintype β] (f : perm β) (e : α ≃ β) :
    coe_fn sign (equiv.trans (equiv.trans e f) (equiv.symm e)) = coe_fn sign f :=
  sign_symm_trans_trans f (equiv.symm e)

theorem sign_prod_list_swap {α : Type u} [DecidableEq α] [fintype α] {l : List (perm α)}
    (hl : ∀ (g : perm α), g ∈ l → is_swap g) : coe_fn sign (list.prod l) = (-1) ^ list.length l :=
  sorry

theorem sign_surjective {α : Type u} [DecidableEq α] [fintype α] (hα : 1 < fintype.card α) :
    function.surjective ⇑sign :=
  sorry

theorem eq_sign_of_surjective_hom {α : Type u} [DecidableEq α] [fintype α] {s : perm α →* units ℤ}
    (hs : function.surjective ⇑s) : s = sign :=
  sorry

theorem sign_subtype_perm {α : Type u} [DecidableEq α] [fintype α] (f : perm α) {p : α → Prop}
    [decidable_pred p] (h₁ : ∀ (x : α), p x ↔ p (coe_fn f x))
    (h₂ : ∀ (x : α), coe_fn f x ≠ x → p x) : coe_fn sign (subtype_perm f h₁) = coe_fn sign f :=
  sorry

@[simp] theorem sign_of_subtype {α : Type u} [DecidableEq α] [fintype α] {p : α → Prop}
    [decidable_pred p] (f : perm (Subtype p)) : coe_fn sign (coe_fn of_subtype f) = coe_fn sign f :=
  sorry

theorem sign_eq_sign_of_equiv {α : Type u} {β : Type v} [DecidableEq α] [fintype α] [DecidableEq β]
    [fintype β] (f : perm α) (g : perm β) (e : α ≃ β)
    (h : ∀ (x : α), coe_fn e (coe_fn f x) = coe_fn g (coe_fn e x)) :
    coe_fn sign f = coe_fn sign g :=
  sorry

theorem sign_bij {α : Type u} {β : Type v} [DecidableEq α] [fintype α] [DecidableEq β] [fintype β]
    {f : perm α} {g : perm β} (i : (x : α) → coe_fn f x ≠ x → β)
    (h :
      ∀ (x : α) (hx : coe_fn f x ≠ x) (hx' : coe_fn f (coe_fn f x) ≠ coe_fn f x),
        i (coe_fn f x) hx' = coe_fn g (i x hx))
    (hi :
      ∀ (x₁ x₂ : α) (hx₁ : coe_fn f x₁ ≠ x₁) (hx₂ : coe_fn f x₂ ≠ x₂),
        i x₁ hx₁ = i x₂ hx₂ → x₁ = x₂)
    (hg : ∀ (y : β), coe_fn g y ≠ y → ∃ (x : α), ∃ (hx : coe_fn f x ≠ x), i x hx = y) :
    coe_fn sign f = coe_fn sign g :=
  sorry

@[simp] theorem support_swap {α : Type u} [DecidableEq α] [fintype α] {x : α} {y : α}
    (hxy : x ≠ y) : support (swap x y) = insert x (singleton y) :=
  sorry

theorem card_support_swap {α : Type u} [DecidableEq α] [fintype α] {x : α} {y : α} (hxy : x ≠ y) :
    finset.card (support (swap x y)) = bit0 1 :=
  sorry

/-- If we apply `prod_extend_right a (σ a)` for all `a : α` in turn,
we get `prod_congr_right σ`. -/
theorem prod_prod_extend_right {β : Type v} {α : Type u_1} [DecidableEq α] (σ : α → perm β)
    {l : List α} (hl : list.nodup l) (mem_l : ∀ (a : α), a ∈ l) :
    list.prod (list.map (fun (a : α) => prod_extend_right a (σ a)) l) = prod_congr_right σ :=
  sorry

@[simp] theorem sign_prod_extend_right {α : Type u} {β : Type v} [DecidableEq α] [fintype α]
    [DecidableEq β] [fintype β] (a : α) (σ : perm β) :
    coe_fn sign (prod_extend_right a σ) = coe_fn sign σ :=
  sorry

theorem sign_prod_congr_right {α : Type u} {β : Type v} [DecidableEq α] [fintype α] [DecidableEq β]
    [fintype β] (σ : α → perm β) :
    coe_fn sign (prod_congr_right σ) = finset.prod finset.univ fun (k : α) => coe_fn sign (σ k) :=
  sorry

theorem sign_prod_congr_left {α : Type u} {β : Type v} [DecidableEq α] [fintype α] [DecidableEq β]
    [fintype β] (σ : α → perm β) :
    coe_fn sign (prod_congr_left σ) = finset.prod finset.univ fun (k : α) => coe_fn sign (σ k) :=
  sorry

@[simp] theorem sign_perm_congr {α : Type u} {β : Type v} [DecidableEq α] [fintype α]
    [DecidableEq β] [fintype β] (e : α ≃ β) (p : perm α) :
    coe_fn sign (coe_fn (perm_congr e) p) = coe_fn sign p :=
  sorry

@[simp] theorem sign_sum_congr {α : Type u} {β : Type v} [DecidableEq α] [fintype α] [DecidableEq β]
    [fintype β] (σa : perm α) (σb : perm β) :
    coe_fn sign (sum_congr σa σb) = coe_fn sign σa * coe_fn sign σb :=
  sorry

end Mathlib