/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module group_theory.perm.option
! leanprover-community/mathlib commit ee05e9ce1322178f0c12004eb93c00d2c8c00ed2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Perm
import Mathbin.GroupTheory.Perm.Sign
import Mathbin.Logic.Equiv.Option

/-!
# Permutations of `option α`

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

open Equiv

/- warning: equiv.option_congr_one -> Equiv.optionCongr_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (OfNat.mk.{u1} (Equiv.Perm.{succ u1} α) 1 (One.one.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))))))) (OfNat.ofNat.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) 1 (OfNat.mk.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) 1 (One.one.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (MulOneClass.toHasOne.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Monoid.toMulOneClass.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α)))))))))
but is expected to have type
  forall {α : Type.{u1}}, Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (One.toOfNat1.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))))) (OfNat.ofNat.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) 1 (One.toOfNat1.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (InvOneClass.toOne.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Group.toDivisionMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))))))
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_one Equiv.optionCongr_oneₓ'. -/
@[simp]
theorem Equiv.optionCongr_one {α : Type _} : (1 : Perm α).optionCongr = 1 :=
  Equiv.optionCongr_refl
#align equiv.option_congr_one Equiv.optionCongr_one

/- warning: equiv.option_congr_swap -> Equiv.optionCongr_swap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α) (y : α), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b) x y)) (Equiv.swap.{succ u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.some.{u1} α x) (Option.some.{u1} α y))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α) (y : α), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b) x y)) (Equiv.swap.{succ u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.some.{u1} α x) (Option.some.{u1} α y))
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_swap Equiv.optionCongr_swapₓ'. -/
@[simp]
theorem Equiv.optionCongr_swap {α : Type _} [DecidableEq α] (x y : α) :
    optionCongr (swap x y) = swap (some x) (some y) :=
  by
  ext (_ | i)
  · simp [swap_apply_of_ne_of_ne]
  · by_cases hx : i = x
    simp [hx, swap_apply_of_ne_of_ne]
    by_cases hy : i = y <;> simp [hx, hy, swap_apply_of_ne_of_ne]
#align equiv.option_congr_swap Equiv.optionCongr_swap

/- warning: equiv.option_congr_sign -> Equiv.optionCongr_sign is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (e : Equiv.Perm.{succ u1} α), Eq.{1} (Units.{0} Int Int.monoid) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) (fun (_x : MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) => (Equiv.Perm.{succ u1} (Option.{u1} α)) -> (Units.{0} Int Int.monoid)) (MonoidHom.hasCoeToFun.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) (Equiv.Perm.sign.{u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.fintype.{u1} α _inst_2)) (Equiv.optionCongr.{u1, u1} α α e)) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) (fun (_x : MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) => (Equiv.Perm.{succ u1} α) -> (Units.{0} Int Int.monoid)) (MonoidHom.hasCoeToFun.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) (Equiv.Perm.sign.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) e)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (e : Equiv.Perm.{succ u1} α), Eq.{1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} (Option.{u1} α)) => Units.{0} Int Int.instMonoidInt) (Equiv.optionCongr.{u1, u1} α α e)) (FunLike.coe.{succ u1, succ u1, 1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (fun (_x : Equiv.Perm.{succ u1} (Option.{u1} α)) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} (Option.{u1} α)) => Units.{0} Int Int.instMonoidInt) _x) (MulHomClass.toFunLike.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α)))))) (MulOneClass.toMul.{0} (Units.{0} Int Int.instMonoidInt) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (MonoidHomClass.toMulHomClass.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt) (MonoidHom.monoidHomClass.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)))) (Equiv.Perm.sign.{u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (instFintypeOption.{u1} α _inst_2)) (Equiv.optionCongr.{u1, u1} α α e)) (FunLike.coe.{succ u1, succ u1, 1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (fun (_x : Equiv.Perm.{succ u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} α) => Units.{0} Int Int.instMonoidInt) _x) (MulHomClass.toFunLike.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (MulOneClass.toMul.{0} (Units.{0} Int Int.instMonoidInt) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (MonoidHomClass.toMulHomClass.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt) (MonoidHom.monoidHomClass.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)))) (Equiv.Perm.sign.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) e)
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_sign Equiv.optionCongr_signₓ'. -/
@[simp]
theorem Equiv.optionCongr_sign {α : Type _} [DecidableEq α] [Fintype α] (e : Perm α) :
    Perm.sign e.optionCongr = Perm.sign e :=
  by
  apply perm.swap_induction_on e
  · simp [perm.one_def]
  · intro f x y hne h
    simp [h, hne, perm.mul_def, ← Equiv.optionCongr_trans]
#align equiv.option_congr_sign Equiv.optionCongr_sign

/- warning: map_equiv_remove_none -> map_equiv_removeNone is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (σ : Equiv.Perm.{succ u1} (Option.{u1} α)), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (Equiv.removeNone.{u1, u1} α α σ)) (HMul.hMul.{u1, u1, u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (instHMul.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (MulOneClass.toHasMul.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Monoid.toMulOneClass.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))))) (Equiv.swap.{succ u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.none.{u1} α) (coeFn.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (fun (_x : Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) => (Option.{u1} α) -> (Option.{u1} α)) (Equiv.hasCoeToFun.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) σ (Option.none.{u1} α))) σ)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (σ : Equiv.Perm.{succ u1} (Option.{u1} α)), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) (Equiv.optionCongr.{u1, u1} α α (Equiv.removeNone.{u1, u1} α α σ)) (HMul.hMul.{u1, u1, u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (instHMul.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))))) (Equiv.swap.{succ u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.none.{u1} α) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Option.{u1} α) (fun (_x : Option.{u1} α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Option.{u1} α) => Option.{u1} α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} α)) σ (Option.none.{u1} α))) σ)
Case conversion may be inaccurate. Consider using '#align map_equiv_remove_none map_equiv_removeNoneₓ'. -/
@[simp]
theorem map_equiv_removeNone {α : Type _} [DecidableEq α] (σ : Perm (Option α)) :
    (removeNone σ).optionCongr = swap none (σ none) * σ :=
  by
  ext1 x
  have : Option.map (⇑(remove_none σ)) x = (swap none (σ none)) (σ x) :=
    by
    cases x
    · simp
    · cases h : σ (some x)
      · simp [remove_none_none _ h]
      · have hn : σ (some x) ≠ none := by simp [h]
        have hσn : σ (some x) ≠ σ none := σ.injective.ne (by simp)
        simp [remove_none_some _ ⟨_, h⟩, ← h, swap_apply_of_ne_of_ne hn hσn]
  simpa using this
#align map_equiv_remove_none map_equiv_removeNone

#print Equiv.Perm.decomposeOption /-
/-- Permutations of `option α` are equivalent to fixing an
`option α` and permuting the remaining with a `perm α`.
The fixed `option α` is swapped with `none`. -/
@[simps]
def Equiv.Perm.decomposeOption {α : Type _} [DecidableEq α] : Perm (Option α) ≃ Option α × Perm α
    where
  toFun σ := (σ none, removeNone σ)
  invFun i := swap none i.1 * i.2.optionCongr
  left_inv σ := by simp
  right_inv := fun ⟨x, σ⟩ =>
    by
    have : remove_none (swap none x * σ.option_congr) = σ :=
      Equiv.optionCongr_injective (by simp [← mul_assoc])
    simp [← perm.eq_inv_iff_eq, this]
#align equiv.perm.decompose_option Equiv.Perm.decomposeOption
-/

#print Equiv.Perm.decomposeOption_symm_of_none_apply /-
theorem Equiv.Perm.decomposeOption_symm_of_none_apply {α : Type _} [DecidableEq α] (e : Perm α)
    (i : Option α) : Equiv.Perm.decomposeOption.symm (none, e) i = i.map e := by simp
#align equiv.perm.decompose_option_symm_of_none_apply Equiv.Perm.decomposeOption_symm_of_none_apply
-/

/- warning: equiv.perm.decompose_option_symm_sign -> Equiv.Perm.decomposeOption_symm_sign is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (e : Equiv.Perm.{succ u1} α), Eq.{1} (Units.{0} Int Int.monoid) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) (fun (_x : MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) => (Equiv.Perm.{succ u1} (Option.{u1} α)) -> (Units.{0} Int Int.monoid)) (MonoidHom.hasCoeToFun.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.mulOneClass.{0} Int Int.monoid)) (Equiv.Perm.sign.{u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.fintype.{u1} α _inst_2)) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (fun (_x : Equiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) => (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) -> (Equiv.Perm.{succ u1} (Option.{u1} α))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (Equiv.symm.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.decomposeOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b))) (Prod.mk.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α) (Option.none.{u1} α) e))) (coeFn.{succ u1, succ u1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) (fun (_x : MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) => (Equiv.Perm.{succ u1} α) -> (Units.{0} Int Int.monoid)) (MonoidHom.hasCoeToFun.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.monoid) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.mulOneClass.{0} Int Int.monoid)) (Equiv.Perm.sign.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) e)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (e : Equiv.Perm.{succ u1} α), Eq.{1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} (Option.{u1} α)) => Units.{0} Int Int.instMonoidInt) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (fun (a : Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) => Equiv.Perm.{succ u1} (Option.{u1} α)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (Equiv.symm.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.decomposeOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b))) (Prod.mk.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α) (Option.none.{u1} α) e))) (FunLike.coe.{succ u1, succ u1, 1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (fun (_x : Equiv.Perm.{succ u1} (Option.{u1} α)) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} (Option.{u1} α)) => Units.{0} Int Int.instMonoidInt) _x) (MulHomClass.toFunLike.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α)))))) (MulOneClass.toMul.{0} (Units.{0} Int Int.instMonoidInt) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (MonoidHomClass.toMulHomClass.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt) (MonoidHom.monoidHomClass.{u1, 0} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.Perm.permGroup.{u1} (Option.{u1} α))))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)))) (Equiv.Perm.sign.{u1} (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (instFintypeOption.{u1} α _inst_2)) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (fun (_x : Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) => Equiv.Perm.{succ u1} (Option.{u1} α)) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α))) (Equiv.symm.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.decomposeOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b))) (Prod.mk.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α) (Option.none.{u1} α) e))) (FunLike.coe.{succ u1, succ u1, 1} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (fun (_x : Equiv.Perm.{succ u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} α) => Units.{0} Int Int.instMonoidInt) _x) (MulHomClass.toFunLike.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (MulOneClass.toMul.{0} (Units.{0} Int Int.instMonoidInt) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (MonoidHomClass.toMulHomClass.{u1, u1, 0} (MonoidHom.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)) (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt) (MonoidHom.monoidHomClass.{u1, 0} (Equiv.Perm.{succ u1} α) (Units.{0} Int Int.instMonoidInt) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt)))) (Equiv.Perm.sign.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) e)
Case conversion may be inaccurate. Consider using '#align equiv.perm.decompose_option_symm_sign Equiv.Perm.decomposeOption_symm_signₓ'. -/
theorem Equiv.Perm.decomposeOption_symm_sign {α : Type _} [DecidableEq α] [Fintype α] (e : Perm α) :
    Perm.sign (Equiv.Perm.decomposeOption.symm (none, e)) = Perm.sign e := by simp
#align equiv.perm.decompose_option_symm_sign Equiv.Perm.decomposeOption_symm_sign

/- warning: finset.univ_perm_option -> Finset.univ_perm_option is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α], Eq.{succ u1} (Finset.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α))) (Finset.univ.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.fintype.{u1, u1} (Option.{u1} α) (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (fun (a : Option.{u1} α) (b : Option.{u1} α) => Option.decidableEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (Option.fintype.{u1} α _inst_2) (Option.fintype.{u1} α _inst_2))) (Finset.map.{u1, u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.toEmbedding.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.symm.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.decomposeOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b)))) (Finset.univ.{u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Prod.fintype.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α) (Option.fintype.{u1} α _inst_2) (Equiv.fintype.{u1, u1} α α (fun (a : α) (b : α) => _inst_1 a b) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 _inst_2))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α], Eq.{succ u1} (Finset.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α))) (Finset.univ.{u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (equivFintype.{u1, u1} (Option.{u1} α) (Option.{u1} α) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (fun (a : Option.{u1} α) (b : Option.{u1} α) => instDecidableEqOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a b) (instFintypeOption.{u1} α _inst_2) (instFintypeOption.{u1} α _inst_2))) (Finset.map.{u1, u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.toEmbedding.{succ u1, succ u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.{succ u1} (Option.{u1} α)) (Equiv.symm.{succ u1, succ u1} (Equiv.Perm.{succ u1} (Option.{u1} α)) (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (Equiv.Perm.decomposeOption.{u1} α (fun (a : α) (b : α) => _inst_1 a b)))) (Finset.univ.{u1} (Prod.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α)) (instFintypeProd.{u1, u1} (Option.{u1} α) (Equiv.Perm.{succ u1} α) (instFintypeOption.{u1} α _inst_2) (equivFintype.{u1, u1} α α (fun (a : α) (b : α) => _inst_1 a b) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 _inst_2))))
Case conversion may be inaccurate. Consider using '#align finset.univ_perm_option Finset.univ_perm_optionₓ'. -/
/-- The set of all permutations of `option α` can be constructed by augmenting the set of
permutations of `α` by each element of `option α` in turn. -/
theorem Finset.univ_perm_option {α : Type _} [DecidableEq α] [Fintype α] :
    @Finset.univ (Perm <| Option α) _ =
      (Finset.univ : Finset <| Option α × Perm α).map Equiv.Perm.decomposeOption.symm.toEmbedding :=
  (Finset.univ_map_equiv_to_embedding _).symm
#align finset.univ_perm_option Finset.univ_perm_option


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

import category_theory.idempotents.functor_extension
import for_mathlib.functor_misc

/-!
# Extension of functors to the idempotent completion

In this file, we obtain an equivalence of categories
`karoubi_universal₁ C D : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)` for
all categories `C` and `D`. The key construction is `functor_extension₁`
which extends a functor `C ⥤ karoubi D` to a functor `karoubi C ⥤ karoubi D`.

TODO : If `D` is idempotent complete, we also have
`karoubi_universal C D : C ⥤ D ≌ karoubi C ⥤ D`.

-/

open category_theory.category
open category_theory.idempotents.karoubi

namespace category_theory

namespace idempotents

variables (C D E : Type*) [category C] [category D] [category E]

namespace karoubi_universal₁

/-
@[simps]
def counit_iso :
  (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ⋙
    functor_extension₁ C D ≅ 𝟭 _ :=
nat_iso.of_components (λ G,
{ hom :=
  { app := λ P,
    { f := (G.map (decomp_id_p P)).f,
      comm := begin
        have eq : P.decomp_id_p = (to_karoubi C).map P.p ≫ P.decomp_id_p ≫ 𝟙 _,
        { simp only [P.idem, decomp_id_p_f, to_karoubi_map_f, id_eq, comp_f, hom_ext], },
        simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map eq,
      end },
      naturality' := λ P Q f, begin
        ext,
        simpa only [hom_ext, G.map_comp] using (G.congr_map (decomp_id_p_naturality f)).symm,
      end },
  inv :=
  { app := λ P,
    { f := (G.map (decomp_id_i P)).f,
      comm := begin
        have eq : P.decomp_id_i = 𝟙 _ ≫ P.decomp_id_i ≫ (to_karoubi C).map P.p,
        { simp only [idem, id_eq, hom_ext, decomp_id_i_f, comp_f, to_karoubi_map_f], },
        simpa only [hom_ext, G.map_comp, G.map_id] using (G.congr_map eq),
      end, },
    naturality' := λ P Q f, begin
      ext,
      simpa only [hom_ext, G.map_comp] using G.congr_map (decomp_id_i_naturality f),
    end },
  hom_inv_id' := begin
    ext P,
    simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_p.symm,
  end,
  inv_hom_id' := begin
    ext P,
    simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_id.symm,
  end, })
begin
  intros G G' φ,
  ext P,
  dsimp,
  simp only [nat_trans_eq φ P, comp_f, functor_extension₁.map_app_f,
    functor.comp_map, whisker_left_app],
  rw [P.decomp_p, G.map_comp, comp_f, assoc, assoc],
  refl,
end-/

end karoubi_universal₁

/-@[simps]
def karoubi_universal₁ : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D) :=
{ functor := functor_extension₁ C D,
  inverse := (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C),
  unit_iso := eq_to_iso (functor_extension₁_comp_whiskering_left_to_karoubi C D).symm,
  counit_iso := karoubi_universal₁.counit_iso C D,
  functor_unit_iso_comp' := λ F, begin
    ext P,
    simpa only [eq_to_iso.hom, eq_to_hom_app, eq_to_hom_map, eq_to_hom_refl, id_comp]
      using F.congr_map P.idem,
  end, }

lemma functor_extension₁_comp
  (F : C ⥤ karoubi D) (G : D ⥤ karoubi E) :
  (functor_extension₁ C E).obj (F ⋙ (functor_extension₁ D E).obj G) =
  (functor_extension₁ C D).obj F ⋙ (functor_extension₁ D E).obj G :=
begin
  apply functor.ext,
  { intros X Y f,
    erw [id_comp, comp_id],
    refl, },
  { intro P,
    ext,
    { dsimp,
      erw [comp_id, id_comp], },
    { refl, }, }
end

@[simps]
def functor_extension₂ : (C ⥤ D) ⥤ (karoubi C ⥤ karoubi D) :=
(whiskering_right C D (karoubi D)).obj (to_karoubi D) ⋙ functor_extension₁ C D

lemma functor_extension₂_comp_whiskering_left_to_karoubi :
  functor_extension₂ C D ⋙ (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) =
  (whiskering_right C D (karoubi D)).obj (to_karoubi D) :=
by simp only [functor_extension₂, functor.assoc_eq,
  functor_extension₁_comp_whiskering_left_to_karoubi, functor.comp_id]

section is_idempotent_complete

variable [is_idempotent_complete D]

noncomputable instance : is_equivalence (to_karoubi D) := to_karoubi_is_equivalence D

@[simps]
noncomputable def karoubi_universal₂ : (C ⥤ D) ≌
  (karoubi C ⥤ karoubi D) :=
(equivalence.congr_right (to_karoubi D).as_equivalence).trans
    (karoubi_universal₁ C D)

lemma karoubi_universal₂_functor_eq :
  (karoubi_universal₂ C D).functor = functor_extension₂ C D := rfl

noncomputable instance : is_equivalence (functor_extension₂ C D) :=
by { rw ← karoubi_universal₂_functor_eq, apply_instance, }

@[simps]
noncomputable def functor_extension :
  (C ⥤ D) ⥤ (karoubi C ⥤ D) :=
functor_extension₂ C D ⋙ (whiskering_right (karoubi C) (karoubi D) D).obj
    (to_karoubi_is_equivalence D).inverse

@[simps]
noncomputable def karoubi_universal : (C ⥤ D) ≌ (karoubi C ⥤ D) :=
(karoubi_universal₂ C D).trans (equivalence.congr_right (to_karoubi D).as_equivalence.symm)

lemma karoubi_universal_functor_eq :
  (karoubi_universal C D).functor = functor_extension C D := rfl

noncomputable instance : is_equivalence (functor_extension C D) :=
by { rw ← karoubi_universal_functor_eq, apply_instance, }

noncomputable instance : is_equivalence ((whiskering_left C (karoubi C) D).obj (to_karoubi C)) :=
begin
  let F₁ := ((whiskering_left C (karoubi C) D).obj (to_karoubi C)),
  let F₂ := ((whiskering_right C _ _).obj (to_karoubi D) ⋙
    (whiskering_right C _ _).obj (to_karoubi D).inv),
  apply is_equivalence.cancel_comp_right F₁ F₂,
  { exact is_equivalence.of_equivalence
      (@equivalence.congr_right _ _ _ _ C _
      ((to_karoubi D).as_equivalence.trans (to_karoubi D).as_equivalence.symm)), },
  { rw [show F₁ ⋙ F₂ = (karoubi_universal C D).inverse, by refl],
    apply_instance, }
end

end is_idempotent_complete-/

end idempotents

end category_theory


import .lovelib

/- # LoVe Demo 8: Operational Semantics

In this and the next two lectures, we will see how to use Lean to specify the
syntax and semantics of programming languages and to reason about the
semantics. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Formal Semantics

A formal semantics helps specify and reason about the programming language
itself, and about individual programs.

It can form the basis of verified compilers, interpreters, verifiers, static
analyzers, type checkers, etc. Without formal proofs, these tools are
**almost always wrong**.

In this area, proof assistants are widely used. Every year, about 10-20% of POPL
papers are partially or totally formalized. Reasons for this success:

* Little machinery (background libraries, tactics) is needed to get started,
  beyond inductive types and predicates and recursive functions.

* The proofs tend to have lots of cases, which is a good match for computers.

* Proof assistants keep track of what needs to be changed when as extend the
  programming language with more features.

Case in point: WebAssembly. To quote Conrad Watt (with some abbreviations):

    We have produced a full Isabelle mechanisation of the core execution
    semantics and type system of the WebAssembly language. To complete this
    proof, **several deficiencies** in the official WebAssembly specification,
    uncovered by our proof and modelling work, needed to be corrected. In some
    cases, these meant that the type system was **originally unsound**.

    We have maintained a constructive dialogue with the working group,
    verifying new features as they are added. In particular, the mechanism by
    which a WebAssembly implementation interfaces with its host environment was
    not formally specified in the working group's original paper. Extending our
    mechanisation to model this feature revealed a deficiency in the WebAssembly
    specification that **sabotaged the soundness** of the type system.

## A Minimalistic Imperative Language

__WHILE__ is a minimalistic imperative language with the following grammar:

    S  ::=  skip                 -- no-op
         |  x := a               -- assignment
         |  S ; S                -- sequential composition
         |  if b then S else S   -- conditional statement
         |  while b do S         -- while loop

where `S` stands for a statement (also called command or program), `x` for a
variable, `a` for an arithmetic expression, and `b` for a Boolean expression. -/

inductive stmt : Type
| skip   : stmt
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| ite    : (state → Prop) → stmt → stmt → stmt
| while  : (state → Prop) → stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/- In our grammar, we deliberately leave the syntax of arithmetic and Boolean
expressions unspecified. In Lean, we have the choice:

* We could use a type such as `aexp` from lecture 1 and similarly for Boolean
  expressions.

* Supposing a state `s` is a function from variable names to values
  (`string → ℕ`), we could decide that an arithmetic expression is simply a
  function from states to natural numbers (`state → ℕ`) and a Boolean expression
  is a predicate (`state → Prop` or `state → bool`).

This corresponds to the difference between deep and shallow embeddings:

* A __deep embedding__ of some syntax (expression, formula, program, etc.)
  consists of an abstract syntax tree specified in the proof assistant
  (e.g., `aexp`) with a semantics (e.g., `eval`).

* In contrast, a __shallow embedding__ simply reuses the corresponding
  mechanisms from the logic (e.g., λ-terms, functions and predicate types).

A deep embedding allows us to reason about the syntax (and its semantics). A
shallow embedding is more lightweight, because we can use it directly, without
having to define a semantics.

We will use a deep embedding of programs (which we find interesting), and
shallow embeddings of assignments and Boolean expressions (which we find
boring).

Examples:

    `λs : state, s "x" + s "y" + 1`   -- x + y + 1
    `λs : state, s "a" ≠ s "b"`       -- a ≠ b

## Big-Step Semantics

An __operational semantics__ corresponds to an idealized interpreter (specified
in a Prolog-like language). Two main variants:

* big-step semantics;

* small-step semantics.

In a __big-step semantics__ (also called __natural semantics__), judgments have
the form `(S, s) ⟹ t`:

    Starting in a state `s`, executing `S` terminates in the state `t`.

Example:

    `(x := x + y; y := 0, [x ↦ 3, y ↦ 5]) ⟹ [x ↦ 8, y ↦ 0]`

Derivation rules:

    ——————————————— Skip
    (skip, s) ⟹ s

    ——————————————————————————— Asn
    (x := a, s) ⟹ s[x ↦ s(a)]

    (S, s) ⟹ t   (T, t) ⟹ u
    ——————————————————————————— Seq
    (S; T, s) ⟹ u

    (S, s) ⟹ t
    ————————————————————————————— If-True   if s(b) is true
    (if b then S else T, s) ⟹ t

    (T, s) ⟹ t
    ————————————————————————————— If-False   if s(b) is false
    (if b then S else T, s) ⟹ t

    (S, s) ⟹ t   (while b do S, t) ⟹ u
    —————————————————————————————————————— While-True   if s(b) is true
    (while b do S, s) ⟹ u

    ————————————————————————— While-False   if s(b) is false
    (while b do S, s) ⟹ s

Above, `s(e)` denotes the value of expression `e` in state `s`.

In Lean, the judgment corresponds to an inductive predicate, and the derivation
rules correspond to the predicate's introduction rules. Using an inductive
predicate as opposed to a recursive function allows us to cope with
nontermination (e.g., a diverging `while`) and nondeterminism (e.g.,
multithreading). -/

inductive big_step : stmt × state → state → Prop
| skip {s} :
  big_step (stmt.skip, s) s
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| seq {S T s t u} (hS : big_step (S, s) t)
    (hT : big_step (T, t) u) :
  big_step (S ;; T, s) u
| ite_true {b : state → Prop} {S T s t} (hcond : b s)
    (hbody : big_step (S, s) t) :
  big_step (stmt.ite b S T, s) t
| ite_false {b : state → Prop} {S T s t} (hcond : ¬ b s)
    (hbody : big_step (T, s) t) :
  big_step (stmt.ite b S T, s) t
| while_true {b : state → Prop} {S s t u} (hcond : b s)
    (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.while b S, t) u) :
  big_step (stmt.while b S, s) u
| while_false {b : state → Prop} {S s} (hcond : ¬ b s) :
  big_step (stmt.while b S, s) s

infix ` ⟹ ` : 110 := big_step

/- ## Properties of the Big-Step Semantics

Equipped with a big-step semantics, we can

* prove properties of the programming language, such as **equivalence proofs**
  between programs and **determinism**;

* reason about **concrete programs**, proving theorems relating final states `t`
  with initial states `s`. -/

lemma big_step_deterministic {S s l r} (hl : (S, s) ⟹ l)
    (hr : (S, s) ⟹ r) :
  l = r :=
begin
  induction' hl,
  case skip {
    cases' hr,
    refl },
  case assign {
    cases' hr,
    refl },
  case seq : S T s t l hS hT ihS ihT {
    cases' hr with _ _ _ _ _ _ _ t' _ hS' hT',
    cases' ihS hS',
    cases' ihT hT',
    refl },
  case ite_true : b S T s t hb hS ih {
    cases' hr,
    { apply ih hr },
    { cc } },
  case ite_false : b S T s t hb hT ih {
    cases' hr,
    { cc },
    { apply ih hr } },
  case while_true : b S s t u hb hS hw ihS ihw {
    cases' hr,
    { cases' ihS hr,
      cases' ihw hr_1,
      refl },
    { cc } },
  { cases' hr,
    { cc },
    { refl } }
end

lemma big_step_terminates {S s} :
  ∃t, (S, s) ⟹ t :=
sorry   -- unprovable

lemma big_step_doesnt_terminate {S s t} :
  ¬ (stmt.while (λ_, true) S, s) ⟹ t :=
begin
  intro hw,
  induction' hw,
  case while_true {
    assumption },
  case while_false {
    cc }
end

/- We can define inversion rules about the big-step semantics: -/

@[simp] lemma big_step_skip_iff {s t} :
  (stmt.skip, s) ⟹ t ↔ t = s :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    refl },
  { intro h,
    rw h,
    exact big_step.skip }
end

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    refl },
  { intro h,
    rw h,
    exact big_step.assign }
end

@[simp] lemma big_step_seq_iff {S T s t} :
  (S ;; T, s) ⟹ t ↔ (∃u, (S, s) ⟹ u ∧ (T, u) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    apply exists.intro,
    apply and.intro; assumption },
  { intro h,
    cases' h,
    cases' h,
    apply big_step.seq; assumption }
end

@[simp] lemma big_step_ite_iff {b S T s t} :
  (stmt.ite b S T, s) ⟹ t ↔
  (b s ∧ (S, s) ⟹ t) ∨ (¬ b s ∧ (T, s) ⟹ t) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h; cases' h,
    { apply big_step.ite_true; assumption },
    { apply big_step.ite_false; assumption } }
end

lemma big_step_while_iff {b S s u} :
  (stmt.while b S, s) ⟹ u ↔
  (∃t, b s ∧ (S, s) ⟹ t ∧ (stmt.while b S, t) ⟹ u)
  ∨ (¬ b s ∧ u = s) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      apply exists.intro t,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    case inl {
      cases' h with t h,
      cases' h with hb h,
      cases' h with hS hwhile,
      exact big_step.while_true hb hS hwhile },
    case inr {
      cases' h with hb hus,
      rw hus,
      exact big_step.while_false hb } }
end

lemma big_step_while_true_iff {b : state → Prop} {S s u}
    (hcond : b s) :
  (stmt.while b S, s) ⟹ u ↔
  (∃t, (S, s) ⟹ t ∧ (stmt.while b S, t) ⟹ u) :=
by rw big_step_while_iff; simp [hcond]

@[simp] lemma big_step_while_false_iff {b : state → Prop}
    {S s t} (hcond : ¬ b s) :
  (stmt.while b S, s) ⟹ t ↔ t = s :=
by rw big_step_while_iff; simp [hcond]

/- ## Small-Step Semantics

A big-step semantics

* does not let us reason about intermediate states;

* does not let us express nontermination or interleaving (for multithreading).

__Small-step semantics__ (also called __structural operational semantics__)
solve the above issues.

A judgment has the form `(S, s) ⇒ (T, t)`:

    Starting in a state `s`, executing one step of `S` leaves us in the
    state `t`, with the program `T` remaining to be executed.

An execution is a finite or infinite chain `(S₀, s₀) ⇒ (S₁, s₁) ⇒ …`.

A pair `(S, s)` is called a __configuration__. It is __final__ if no transition
of the form `(S, s) ⇒ _` is possible.

Example:

      `(x := x + y; y := 0, [x ↦ 3, y ↦ 5])`
    `⇒ (skip; y := 0,       [x ↦ 8, y ↦ 5])`
    `⇒ (y := 0,             [x ↦ 8, y ↦ 5])`
    `⇒ (skip,               [x ↦ 8, y ↦ 0])`

Derivation rules:

    ————————————————————————————————— Asn
    (x := a, s) ⇒ (skip, s[x ↦ s(a)])

    (S, s) ⇒ (S', s')
    ———-————————————————————— Seq-Step
    (S ; T, s) ⇒ (S' ; T, s')

    —————————————————————— Seq-Skip
    (skip ; S, s) ⇒ (S, s)

    ———————————————————————————————— If-True   if s(b) is true
    (if b then S else T, s) ⇒ (S, s)

    ———————————————————————————————— If-False   if s(b) is false
    (if b then S else T, s) ⇒ (T, s)

    ——————————————————————————————————————————————————————————————— While
    (while b do S, s) ⇒ (if b then (S ; while b do S) else skip, s)

There is no rule for `skip` (why?). -/

inductive small_step : stmt × state → stmt × state → Prop
| assign {x a s} :
  small_step (stmt.assign x a, s) (stmt.skip, s{x ↦ a s})
| seq_step {S S' T s s'} (hS : small_step (S, s) (S', s')) :
  small_step (S ;; T, s) (S' ;; T, s')
| seq_skip {T s} :
  small_step (stmt.skip ;; T, s) (T, s)
| ite_true {b : state → Prop} {S T s} (hcond : b s) :
  small_step (stmt.ite b S T, s) (S, s)
| ite_false {b : state → Prop} {S T s} (hcond : ¬ b s) :
  small_step (stmt.ite b S T, s) (T, s)
| while {b : state → Prop} {S s} :
  small_step (stmt.while b S, s)
    (stmt.ite b (S ;; stmt.while b S) stmt.skip, s)

infixr ` ⇒ ` := small_step
infixr ` ⇒* ` : 100 := star small_step

/- Equipped with a small-step semantics, we can **define** a big-step
semantics:

    `(S, s) ⟹ t` if and only if `(S, s) ⇒* (skip, t)`

where `r*` denotes the reflexive transitive closure of a relation `r`.

Alternatively, if we have already defined a big-step semantics, we can **prove**
the above equivalence theorem to validate our definitions.

The main disadvantage of small-step semantics is that we now have two relations,
`⇒` and `⇒*`, and reasoning tends to be more complicated.

## Properties of the Small-Step Semantics

We can prove that a configuration `(S, s)` is final if and only if `S = skip`.
This ensures that we have not forgotten a derivation rule. -/

lemma small_step_final (S s) :
  (¬ ∃T t, (S, s) ⇒ (T, t)) ↔ S = stmt.skip :=
begin
  induction' S,
  case skip {
    simp,
    intros T t hstep,
    cases' hstep },
  case assign : x a {
    simp,
    apply exists.intro stmt.skip,
    apply exists.intro (s{x ↦ a s}),
    exact small_step.assign },
  case seq : S T ihS ihT {
    simp,
    cases' classical.em (S = stmt.skip),
    case inl {
      rw h,
      apply exists.intro T,
      apply exists.intro s,
      exact small_step.seq_skip },
    case inr {
      simp [h, auto.not_forall_eq, auto.not_not_eq] at ihS,
      cases' ihS s with S' hS',
      cases' hS' with s' hs',
      apply exists.intro (S' ;; T),
      apply exists.intro s',
      exact small_step.seq_step hs' } },
  case ite : b S T ihS ihT {
    simp,
    cases' classical.em (b s),
    case inl {
      apply exists.intro S,
      apply exists.intro s,
      exact small_step.ite_true h },
    case inr {
      apply exists.intro T,
      apply exists.intro s,
      exact small_step.ite_false h } },
  case while : b S ih {
    simp,
    apply exists.intro (stmt.ite b (S ;; stmt.while b S) stmt.skip),
    apply exists.intro s,
    exact small_step.while }
end

lemma small_step_deterministic {S s Ll Rr}
    (hl : (S, s) ⇒ Ll) (hr : (S, s) ⇒ Rr) :
  Ll = Rr :=
begin
  induction' hl,
  case assign : x a s {
    cases' hr,
    refl },
  case seq_step : S S₁ T s s₁ hS₁ ih {
    cases' hr,
    case seq_step : S S₂ _ _ s₂ hS₂ {
      have hSs₁₂ := ih hS₂,
      cc },
    case seq_skip {
      cases' hS₁ } },
  case seq_skip : T s {
    cases' hr,
    { cases' hr },
    { refl } },
  case ite_true : b S T s hcond {
    cases' hr,
    case ite_true {
      refl },
    case ite_false {
      cc } },
  case ite_false : b S T s hcond {
    cases' hr,
    case ite_true {
      cc },
    case ite_false {
      refl } },
  case while : b S s {
    cases' hr,
    refl }
end

/- We can define inversion rules also about the small-step semantics. Here are
three examples: -/

lemma small_step_skip {S s t} :
  ¬ ((stmt.skip, s) ⇒ (S, t)) :=
by intro h; cases' h

@[simp] lemma small_step_seq_iff {S T s Ut} :
  (S ;; T, s) ⇒ Ut ↔
  (∃S' t, (S, s) ⇒ (S', t) ∧ Ut = (S' ;; T, t))
  ∨ (S = stmt.skip ∧ Ut = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      apply exists.intro S',
      apply exists.intro s',
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    { cases' h,
      cases' h,
      cases' h,
      rw right,
      apply small_step.seq_step,
      assumption },
    { cases' h,
      rw left,
      rw right,
      apply small_step.seq_skip } }
end

@[simp] lemma small_step_ite_iff {b S T s Us} :
  (stmt.ite b S T, s) ⇒ Us ↔
  (b s ∧ Us = (S, s)) ∨ (¬ b s ∧ Us = (T, s)) :=
begin
  apply iff.intro,
  { intro h,
    cases' h,
    { apply or.intro_left,
      cc },
    { apply or.intro_right,
      cc } },
  { intro h,
    cases' h,
    { cases' h,
      rw right,
      apply small_step.ite_true,
      assumption },
    { cases' h,
      rw right,
      apply small_step.ite_false,
      assumption } }
end

/- ### Equivalence of the Big-Step and the Small-Step Semantics (**optional**)

A more important result is the connection between the big-step and the
small-step semantics:

    `(S, s) ⟹ t ↔ (S, s) ⇒* (stmt.skip, t)`

Its proof, given below, is beyond the scope of this course. -/

lemma star_small_step_seq {S T s u}
    (h : (S, s) ⇒* (stmt.skip, u)) :
  (S ;; T, s) ⇒* (stmt.skip ;; T, u) :=
begin
  apply star.lift (λSs, (prod.fst Ss ;; T, prod.snd Ss)) _ h,
  intros Ss Ss' h,
  cases' Ss,
  cases' Ss',
  apply small_step.seq_step,
  assumption
end

lemma star_small_step_of_big_step {S s t} (h : (S, s) ⟹ t) :
  (S, s) ⇒* (stmt.skip, t) :=
begin
  induction' h,
  case skip {
    refl },
  case assign {
    exact star.single small_step.assign },
  case seq : S T s t u hS hT ihS ihT {
    transitivity,
    exact star_small_step_seq ihS,
    apply star.head small_step.seq_skip ihT },
  case ite_true : b S T s t hs hst ih {
    exact star.head (small_step.ite_true hs) ih },
  case ite_false : b S T s t hs hst ih {
    exact star.head (small_step.ite_false hs) ih },
  case while_true : b S s t u hb hS hw ihS ihw {
    exact (star.head small_step.while
      (star.head (small_step.ite_true hb)
         (star.trans (star_small_step_seq ihS)
            (star.head small_step.seq_skip ihw)))) },
  case while_false : b S s hb {
    exact star.tail (star.single small_step.while)
      (small_step.ite_false hb) }
end

lemma big_step_of_small_step_of_big_step {S₀ S₁ s₀ s₁ s₂}
  (h₁ : (S₀, s₀) ⇒ (S₁, s₁)) :
  (S₁, s₁) ⟹ s₂ → (S₀, s₀) ⟹ s₂ :=
begin
  induction' h₁;
    simp [*, big_step_while_true_iff] {contextual := tt},
  case seq_step {
    intros u hS' hT,
    apply exists.intro u,
    exact and.intro (ih hS') hT }
end

lemma big_step_of_star_small_step {S s t} :
  (S, s) ⇒* (stmt.skip, t) → (S, s) ⟹ t :=
begin
  generalize hSs : (S, s) = Ss,
  intro h,
  induction h
      using LoVe.rtc.star.head_induction_on
      with _ S's' h h' ih
      generalizing S s;
    cases' hSs,
  { exact big_step.skip },
  { cases' S's' with S' s',
    apply big_step_of_small_step_of_big_step h,
    apply ih,
    refl }
end

lemma big_step_iff_star_small_step {S s t} :
  (S, s) ⟹ t ↔ (S, s) ⇒* (stmt.skip, t) :=
iff.intro star_small_step_of_big_step
  big_step_of_star_small_step

/- ## Parallelism (**optional**) -/

inductive par_step :
    nat → list stmt × state → list stmt × state → Prop
| intro {Ss Ss' S S' s s' i}
    (hi : i < list.length Ss)
    (hS : S = list.nth_le Ss i hi)
    (hs : (S, s) ⇒ (S', s'))
    (hS' : Ss' = list.update_nth Ss i S') :
  par_step i (Ss, s) (Ss', s')

lemma par_step_diamond {i j Ss Ts Ts' s t t'}
    (hi : i < list.length Ss)
    (hj : j < list.length Ss)
    (hij : i ≠ j)
    (hT : par_step i (Ss, s) (Ts, t))
    (hT' : par_step j (Ss, s) (Ts', t')) :
  ∃u Us, par_step j (Ts, t) (Us, u) ∧
    par_step i (Ts', t') (Us, u) :=
sorry   -- unprovable

def stmt.W : stmt → set string
| stmt.skip         := ∅
| (stmt.assign x _) := {x}
| (stmt.seq S T)    := stmt.W S ∪ stmt.W T
| (stmt.ite _ S T)  := stmt.W S ∪ stmt.W T
| (stmt.while _ S)  := stmt.W S

def exp.R {α : Type} : (state → α) → set string
| f := {x | ∀s n, f (s{x ↦ n}) ≠ f s}

def stmt.R : stmt → set string
| stmt.skip         := ∅
| (stmt.assign _ a) := exp.R a
| (stmt.seq S T)    := stmt.R S ∪ stmt.R T
| (stmt.ite b S T)  := exp.R b ∪ stmt.R S ∪ stmt.R T
| (stmt.while b S)  := exp.R b ∪ stmt.R S

def stmt.V : stmt → set string
| S := stmt.W S ∪ stmt.R S

lemma par_step_diamond_VW_disjoint {i j Ss Ts Ts' s t t'}
    (hiS : i < list.length Ss)
    (hjT : j < list.length Ts)
    (hij : i ≠ j)
    (hT : par_step i (Ss, s) (Ts, t))
    (hT' : par_step j (Ss, s) (Ts', t'))
    (hWV : stmt.W (list.nth_le Ss i hiS)
       ∩ stmt.V (list.nth_le Ts j hjT) = ∅)
    (hVW : stmt.V (list.nth_le Ss i hiS)
       ∩ stmt.W (list.nth_le Ts j hjT) = ∅) :
  ∃u Us, par_step j (Ts, t) (Us, u) ∧
    par_step i (Ts', t') (Us, u) :=
sorry   -- this should be provable

end LoVe


import Graph.Graph
import Graph.UndirectedGraph
import Std.Data.Queue
import Std.Data.Stack
import Std.Data.HashSet

/-!
## Traverse (old)

*Note that this module in not imported by default through `import Graph`, import it explicitly using `import Graph.TraverseDeprecated`.*

This is a nice implementation of depth- and breadth-first search using shared code and a stack and queue respectively. However, due to the limitations of such an implementation these functions are fairly inefficient, in general you should rather use `Graph.Traverse`.
-/

import Graph.Container

namespace Graph

open Internal

variable {α : Type} [Inhabited α] {β : Type}

private def traverseAux {containerType : Type _} (g : Graph α β) (startingContainer : Container (Nat × Bool) containerType) (startingSources : Array Nat) (startingState : γ) (visit : Nat -> γ -> γ × Bool) (leave : Option (Nat -> γ -> γ)) : γ := do
  let mut visited : Array Bool := mkArray g.vertexCount false
  let mut state := startingState
  let mut container := startingContainer
  let mut sources := startingSources
  let mut terminate? : Bool := false
  for i in [0:maximumIterationCount] do
    match container.remove? with
      | none =>
        if terminate? || sources.isEmpty then break
        container := container.add (sources.back, true)
        sources := sources.pop
      | some ((currentNodeId, true), newContainer) =>
        container := newContainer
        if terminate? || visited[currentNodeId] then continue
        (state, terminate?) := visit currentNodeId state
        if !leave.isSome && terminate? then break
        visited := visited.set! currentNodeId true
        container := if leave.isSome then container.add (currentNodeId, false) else container
        container := if terminate? then container else
          let unvisitedNeighborIds := (g.vertices[currentNodeId].adjacencyList.map (λ e => e.target)).filter (λ e => !visited[e])
          let unvisitedNeighborIdsWithArrivingFlags := unvisitedNeighborIds.map (λ id => (id, true))
          container.addAll unvisitedNeighborIdsWithArrivingFlags
      | some ((currentNodeId, false), newContainer) =>
        container := newContainer
        match leave with
          | some leaveFunction => state := leaveFunction currentNodeId state
          | none => panic! "This should not be possible"

  return state
  where
    maximumIterationCount : Nat := visitingAndLeavingEachVertex + addingAllSourcesToContainer + visitingSameVertexMultipleTimes + goodMeasure
    visitingAndLeavingEachVertex := g.vertexCount * 2
    addingAllSourcesToContainer := startingSources.size
    visitingSameVertexMultipleTimes := g.edgeCount
    goodMeasure := 1

/-- A breadth-first traversal of the graph starting at the sources in order. Nodes on the same "level" of the traversal are visited in order of the edges added.
    Visit is a function executed at each vertex, its parameters are the vertex ID and the current state,
    it returns a new state and a boolean which terminates the traversal if true. Please provide a starting state.
    *Note that this function scales significantly worse than `breadthFirstTraverse`.*
    See example uses in Graph/TraverseExample.lean -/
def breadthFirstTraverseDeprecated (g : Graph α β) (sources : Array Nat) (startingState : γ ) (visit : Nat -> γ -> γ × Bool) : γ :=
  traverseAux g Container.emptyQueue sources.reverse startingState visit none

/-- A depth-first traversal of the graph starting at the sources in order. Nodes on the same "level" of the traversal are visited in order of the edges added.
    Visit is a function executed at each vertex, its parameters are the vertex ID and the current state,
    it returns a new state and a boolean which terminates the traversal if true (but will still leave the already visited nodes).
    Leave is executed when the node is left, when all its successors have been visited, uses the same state. Please provide a starting state.
    *Note that this function scales significantly worse than `dephtFirstTraverse`.*
    See example uses in Graph/TraverseExample.lean -/
def depthFirstTraverseDeprecated (g : Graph α β) (sources : Array Nat) (startingState : γ ) (visit : Nat -> γ -> γ × Bool) (leave : Option (Nat -> γ -> γ ) := none) : γ :=
  traverseAux g Container.emptyStack sources.reverse startingState visit leave

namespace UndirectedGraph

/-- See directed graph. -/
def breadthFirstTraverseDeprecated (ug : UndirectedGraph α β) (sources : Array Nat) (startingState : γ ) (visit : Nat -> γ -> γ × Bool) : γ :=
  ug.graph.breadthFirstTraverseDeprecated sources startingState visit

/-- See directed graph. -/
def depthFirstTraverseDeprecated (ug : UndirectedGraph α β) (sources : Array Nat) (startingState : γ ) (visit : Nat -> γ -> γ × Bool) (leave : Option (Nat -> γ -> γ ) := none) : γ :=
  ug.graph.depthFirstTraverseDeprecated sources startingState visit leave

end UndirectedGraph
end Graph


import category_theory.concrete_category
import o_minimal.definable

/-
The category of (literal) definable subsets of Rⁿ
and definable functions between them (not just continuous ones).
Used as the index category for "definable sheaves".
-/

namespace o_minimal

universe u

variables {R : Type u} (S : struc R)

structure Def : Type u :=
(ambdim : ℕ)
(to_set : set (finvec ambdim R))
(is_definable : def_set S to_set)

variables {S}

instance : has_coe_to_sort (Def S) :=
⟨Type u, λ X, X.to_set⟩

instance is_definable.Def (K : Def S) : is_definable S K :=
is_definable.subtype K.is_definable

@[ext] structure Hom (X Y : Def S) : Type u :=
(to_fun : X → Y)
(is_definable : def_fun S to_fun)

instance {X Y : Def S} : has_coe_to_fun (Hom X Y) :=
⟨_, λ f, f.to_fun⟩

instance : category_theory.small_category (Def S) :=
{ hom := Hom,
  id := λ X, ⟨id, def_fun.id⟩,
  comp := λ X Y Z f g, ⟨g.1 ∘ f.1, g.2.comp f.2⟩ }

instance : category_theory.concrete_category.{u} (Def S) :=
{ forget := { obj := λ X, X, map := λ X Y f, f },
  forget_faithful := by tidy }

section pullback

variables {X Y Z : Def S} (f : X ⟶ Z) (g : Y ⟶ Z)

def Def.pullback : Def S :=
{ ambdim := X.ambdim + Y.ambdim,
  to_set :=
    {p | ∃ (hX : p.left ∈ X.to_set) (hY : p.right ∈ Y.to_set),
         f.to_fun ⟨p.left, hX⟩ = g.to_fun ⟨p.right, hY⟩},
  is_definable := begin
    -- TODO: This proof is bad; but how to fix it?
    have := def_set_eq (f.is_definable.comp def_fun.fst) (g.is_definable.comp def_fun.snd),
    change S.definable _ at this,
    change S.definable _,
    convert this using 1,
    ext u,
    revert u,
    refine finvec.rec (λ v w, _),
    simp only [has_coordinates.subtype_coords, set.mem_image,
      function.comp_app, has_coordinates.finvec_coords, set.mem_set_of_eq,
      set.image_id', has_coordinates.prod_coords, subtype.val_eq_coe, prod.exists],
    change (∃ (hX : (v.append w).left ∈ X.to_set) (hY : (v.append w).right ∈ Y.to_set), _) ↔ _,
    split; rintro ⟨x, y, H⟩,
    { exact ⟨⟨v, by simpa using x⟩, ⟨w, by simpa using y⟩, by simpa using H, rfl⟩ },
    { obtain ⟨H₁, H₂⟩ := H,
      obtain ⟨rfl, rfl⟩ := finvec.append.inj_iff.mp H₂, clear H₂,
      refine ⟨by simp, by simp, by simp [H₁]⟩ }
  end }

def Def.pullback.π₁ : Def.pullback f g ⟶ X :=
{ to_fun := λ p, ⟨p.val.left, p.property.fst⟩,
  is_definable := def_fun_subtype_mk (def_fun.finvec.left.comp def_fun_subtype_val) _ }

def Def.pullback.π₂ : Def.pullback f g ⟶ Y :=
{ to_fun := λ p, ⟨p.val.right, p.property.snd.fst⟩,
  is_definable := def_fun_subtype_mk (def_fun.finvec.right.comp def_fun_subtype_val) _ }

end pullback

/-- A (generating) covering family of a given object `K : Def S`.
By definition, it is a finite family of definable maps which is
jointly surjective. -/
structure Def.cover (K : Def S) :=
(n : ℕ)
(obj : fin n → Def S)
(map : Π i, obj i ⟶ K)
(jointly_surjective : ∀ k, ∃ i l, map i l = k)

lemma Def.set_subcanonical
  {K : Def S} (𝓛 : K.cover) (s : set K) (h : Π i, def_set S (𝓛.map i ⁻¹' s)) :
  def_set S s :=
begin
  have : ∀ i, def_set S (𝓛.map i '' (𝓛.map i ⁻¹' s)) :=
    λ i, (𝓛.map i).is_definable.image (h i),
  convert def_set_Union this,
  ext k,
  simp only [set.mem_Union, set.mem_image, set.mem_preimage],
  split; intro hk,
  { obtain ⟨i, l, rfl⟩ := 𝓛.jointly_surjective k,
    refine ⟨i, l, hk, rfl⟩ },
  { obtain ⟨i, l, hl, rfl⟩ := hk,
    exact hl }
end

lemma Def.subcanonical {Y : Type*} [has_coordinates R Y] [is_definable S Y]
  {K : Def S} (𝓛 : K.cover) (f : K → Y) (h : Π i, def_fun S (f ∘ 𝓛.map i)) :
  def_fun S f :=
begin
  unfold def_fun at ⊢ h,
  -- We could pull back the cover to K × Y and use the previous proof,
  -- but it seems easier to just repeat it
  have : ∀ i, def_set S ((λ (p : 𝓛.obj i × Y), (𝓛.map i p.1, p.2)) '' _) :=
    λ i, ((𝓛.map i).is_definable.prod def_fun.id).image (h i),
  convert def_set_Union this using 1,
  ext ⟨k, y⟩,
  simp only [set.mem_Union, set.mem_image, prod.mk.inj_iff, function.comp_app,
    set.mem_set_of_eq, exists_eq_left', prod.exists],
  split,
  { rintro rfl,
    obtain ⟨i, l, rfl⟩ := 𝓛.jointly_surjective k,
    refine ⟨i, l, rfl, rfl⟩ },
  { rintro ⟨i, l, hl, rfl⟩,
    rw hl }
end

def Def.cover.pullback {K : Def S} (𝓛 : K.cover) {K' : Def S} (φ : K' ⟶ K) : K'.cover :=
{ n := 𝓛.n,
  obj := λ i, Def.pullback φ (𝓛.map i),
  map := λ i, Def.pullback.π₁ φ (𝓛.map i),
  jointly_surjective := λ k',
    let ⟨i, l, h⟩ := 𝓛.jointly_surjective (φ k') in
    ⟨i, ⟨finvec.append k' l, by simp, by simp, by simpa using h.symm⟩,
     by { ext1, apply finvec.left_append }⟩ }

-- TODO: add lemmas for the properties of `Def.cover.pullback` that we actually use
-- (for example, we probably don't actually need it to be formed from pullbacks)

end o_minimal


import category_theory.limits.shapes
import category_theory.limits.preserves.limits

import subobject_classifier
import pullbacks

/-!
# Image inside a topos

Prove that there is an image factorisation for each morphism inside a topos
TODO : prove that e is epi, will be needed for the forcing.
-/
open category_theory category_theory.category category_theory.limits classifier

noncomputable theory
universes u v
variables {C : Type u} [category.{v} C] [has_finite_limits C] [has_subobject_classifier C]

/- We need to prove some statement about the image now -/
namespace image

def monic_to_canonical_fork {X Y : C} (m : X ⟶ Y) [mono m] :
  fork (lift_truth Y) (classifier_of m) :=
begin
  apply fork.of_ι m, rw [←assoc', terminal.comp_from m, pb_classifier_condition]
end

@[simp] lemma monic_to_canonical_fork_simp {X Y : C} (m : X ⟶ Y) [mono m] :
  (monic_to_canonical_fork m).ι = m := by refl

/-
  In a topos, every monic is an equalizer, [SML94] pp167
-/
lemma monic_is_limit_fork {X Y : C} (m : X ⟶ Y) [mono m] : is_limit (monic_to_canonical_fork m) :=
begin
  refine fork.is_limit.mk (monic_to_canonical_fork m) _ _ _; intro s;
  have comm : s.ι ≫ classifier_of m = terminal.from s.X ≫ truth C :=
  begin
    rw [←s.condition, ←assoc, cancel_mono], exact terminal.comp_from _
  end,
  { apply pb_lift_from_monic.map m s.ι comm },
  { apply pb_lift_from_monic.comm m s.ι comm },
  { apply pb_lift_from_monic.unique m s.ι comm },
end

def monic_to_fork_lift {X Y : C} (m : X ⟶ Y) [mono m]
  (f : fork (lift_truth Y) (classifier_of m)) :=
fork.is_limit.lift' (monic_is_limit_fork m) (fork.ι f) (fork.condition f)

variable [has_pushouts C]

abbreviation cokernel {X Y : C} (f : X ⟶ Y) := pushout f f
abbreviation cokernel.x {X Y : C} (f : X ⟶ Y) := (pushout.inl : Y ⟶ cokernel f)
abbreviation cokernel.y {X Y : C} (f : X ⟶ Y) := (pushout.inr : Y ⟶ cokernel f)

def canonical_factorisation {X Y : C} (f : X ⟶ Y) : mono_factorisation f :=
{ I := equalizer.{v} (cokernel.x f) (cokernel.y f),
  m := equalizer.ι (cokernel.x f) (cokernel.y f),
  e := equalizer.lift f pushout.condition }

def canonical_factorisation_condition {X Y : C} (f : X ⟶ Y) :
  (canonical_factorisation f).m ≫ (cokernel.x f) =
  (canonical_factorisation f).m ≫ (cokernel.y f) :=
equalizer.condition _ _

/- from [SML94] p185 -/
lemma is_image_make {X Y : C} (f : X ⟶ Y) (F' : mono_factorisation f) :
  {l // l ≫ (monic_to_canonical_fork F'.m).ι = (canonical_factorisation f).m} :=
begin
  let s := lift_truth Y,
  let t := classifier_of F'.m,
  have h : f ≫ s = f ≫ t := by rw [←F'.fac, assoc, ←(monic_to_canonical_fork_simp F'.m),
                                    fork.condition (monic_to_canonical_fork F'.m), assoc],
  have h1 : (canonical_factorisation f).m ≫ s = (canonical_factorisation f).m ≫ t :=
  begin
    rw [←pushout.inl_desc s t h, ←assoc, canonical_factorisation_condition f], simp
  end,
  exact fork.is_limit.lift' (monic_is_limit_fork F'.m) (canonical_factorisation f).m (h1)
end

def is_image_canonical_factorisation {X Y : C} (f : X ⟶ Y) :
  is_image (canonical_factorisation f) :=
{ lift := λ F', (is_image_make f F').val,
  lift_fac' := λ F', (is_image_make f F').prop }

def image_facto {X Y : C} (f : X ⟶ Y) : image_factorisation f :=
{ F := canonical_factorisation f,
  is_image := is_image_canonical_factorisation f }

instance has_image_topos : has_images C :=
{ has_image := λ _ _ f, has_image.mk (image_facto f) }

end image


import pseudo_normed_group.bounded_limits
import category_theory.limits.concrete_category

open category_theory
open category_theory.limits
open_locale nnreal

universes u
variables {J : Type u} [small_category J]
  {F : J ⥤ CompHausFiltPseuNormGrp₁.{u}}
  (C : cone F)

namespace CompHaus

lemma comp_apply {X Y Z : CompHaus} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g) x = g (f x) := rfl

lemma id_apply (X : CompHaus) (x : X) : (𝟙 X : X ⟶ X) x = x := rfl

lemma continuous_of_is_limit (F : J ⥤ CompHaus.{u}) (C : cone F) (hC : is_limit C)
  (Y : Type u) [topological_space Y] (t : Y → C.X)
  (h : ∀ j, continuous (C.π.app j ∘ t)) : continuous t :=
begin
  let CC := CompHaus_to_Top.map_cone C,
  let hCC : is_limit CC := is_limit_of_preserves CompHaus_to_Top hC,
  let E : cone (F ⋙ CompHaus_to_Top) := ⟨Top.of Y, λ j, ⟨_,h j⟩, _⟩,
  { convert (hCC.lift E).continuous,
    ext1 a,
    apply concrete.is_limit_ext _ hCC, intros j,
    change _ = (hCC.lift E ≫ CC.π.app j) _,
    rw hCC.fac, refl },
  { intros i j f, ext,
    change _ = (C.π.app _ ≫ F.map _) _,
    rw C.w,
    refl }
end

lemma injective_of_is_iso {X Y : CompHaus} (f : X ⟶ Y) [is_iso f] :
  function.injective f :=
begin
  intros x y h,
  apply_fun (inv f) at h,
  simp only [← CompHaus.comp_apply, is_iso.hom_inv_id] at h,
  exact h
end

end CompHaus

namespace CompHausFiltPseuNormGrp₁

noncomputable theory

/-- A choice of level for some element of an exhaustive
CompHausly filtered pseudo normed group. -/
def lvl (X : CompHausFiltPseuNormGrp₁) (x : X) : ℝ≥0 :=
(X.exhaustive x).some

lemma lvl_spec (X : CompHausFiltPseuNormGrp₁) (x : X) :
  x ∈ pseudo_normed_group.filtration X (X.lvl x) :=
(X.exhaustive x).some_spec

/-- Consider an element of an exhaustive CompHausly filtered pseudo normed group
as an element of its chosen level. -/
def as_lvl (X : CompHausFiltPseuNormGrp₁) (x : X) :
  (level.obj (X.lvl x)).obj X :=
⟨x, (X.lvl_spec x)⟩

@[reassoc]
lemma level_cone_compatible (c₁ c₂ : ℝ≥0) (e : c₁ ⟶ c₂) (j) :
  (level.map e).app _ ≫ ((level.obj _).map_cone C).π.app j =
  ((level.obj _).map_cone C).π.app j ≫ (level.map e).app _ := rfl

namespace level_jointly_reflects_limits

variables (hC : Π c : ℝ≥0, is_limit ((level.obj c).map_cone C))
variables (S : cone F)

/-- An auxiliary definition to be used in the constructions below. -/
def lift_fun : S.X → C.X :=
λ s, ((hC (S.X.lvl s)).lift ((level.obj _).map_cone S) (S.X.as_lvl s)).1

lemma lift_fun_map_zero : lift_fun C hC S 0 = 0 :=
begin
  --dsimp [lift_fun],  -- slows down the proof.  changes to goal to
  -- ⊢ ((hC (S.X.lvl 0)).lift ((level.obj (S.X.lvl 0)).map_cone S)) (S.X.as_lvl 0) = 0
  let a := ((hC (S.X.lvl 0)).lift ((level.obj (S.X.lvl 0)).map_cone S)) (S.X.as_lvl 0),
  let b := (C.X.as_lvl 0),
  let c₁ := S.X.lvl 0,
  let c₂ := C.X.lvl 0,
  let c := c₁ ⊔ c₂,
  let i1 : c₁ ⟶ c := hom_of_le le_sup_left,
  let i2 : c₂ ⟶ c := hom_of_le le_sup_right,
  let e1 := (level.map i1).app C.X,
  let e2 := (level.map i2).app C.X,
  change (e1 a).1 = (e2 b).1, congr' 1,
  apply concrete.is_limit_ext _ (hC c),
  intros j, dsimp only [e1, e2, a, b, ← CompHaus.comp_apply],
  simp only [category.assoc, level_cone_compatible, (hC (S.X.lvl 0)).fac_assoc],
  ext1,
  change (S.π.app j) 0 = (C.π.app j) 0, -- was `dsimp [CompHaus.comp_apply, level, as_lvl],`
  rw [(S.π.app j).map_zero, (C.π.app j).map_zero],
end

lemma fac_aux (c) (x) (j) :
  C.π.app j ((hC c).lift ((level.obj c).map_cone S) x).1 =
  S.π.app j x.1 :=
begin
  change
    (((hC c).lift ((level.obj c).map_cone S) ≫
      (level.obj c).map (C.π.app j)) x).1 = _,
  erw (hC c).fac,
  refl,
end

lemma lift_fun_map_add (x y) : lift_fun C hC S (x + y) =
  lift_fun C hC S x + lift_fun C hC S y :=
begin
  --dsimp [lift_fun],  -- slows down the proof.  changes the goal to
  -- ⊢ ((hC (S.X.lvl 0)).lift ((level.obj (S.X.lvl 0)).map_cone S)) (S.X.as_lvl 0) = 0
  let Axy := ((hC (S.X.lvl (x + y))).lift
    ((level.obj (S.X.lvl (x + y))).map_cone S)) (S.X.as_lvl (x + y)),
  let Ax := ((hC (S.X.lvl x)).lift
    ((level.obj (S.X.lvl x)).map_cone S)) (S.X.as_lvl x),
  let Ay := ((hC (S.X.lvl y)).lift
    ((level.obj (S.X.lvl y)).map_cone S)) (S.X.as_lvl y),
  let cxy := S.X.lvl (x + y),
  let cx := S.X.lvl x,
  let cy := S.X.lvl y,
  let cc := cxy ⊔ (cx + cy),
  let AA : (level.obj (cx + cy)).obj C.X :=
    ⟨Ax.1 + Ay.1, pseudo_normed_group.add_mem_filtration Ax.2 Ay.2⟩,
  let i1 : cxy ⟶ cc := hom_of_le le_sup_left,
  let i2 : (cx + cy) ⟶ cc := hom_of_le le_sup_right,
  let e1 := (level.map i1).app C.X,
  let e2 := (level.map i2).app C.X,
  change (e1 Axy).1 = (e2 AA).1, congr' 1,
  apply concrete.is_limit_ext _ (hC cc), intros j,
--  dsimp only [e1, e2, Axy, ← CompHaus.comp_apply],
  simp only [e1, e2, Axy, ← CompHaus.comp_apply, category.assoc, level_cone_compatible,
    (hC (S.X.lvl (x + y))).fac_assoc],
  ext1,
  dsimp [CompHaus.comp_apply, level, as_lvl, AA],

  rw [(S.π.app j).map_add, (C.π.app j).map_add],
  congr' 1,
  { dsimp only [Ax],
    erw fac_aux, refl },
  { dsimp only [Ay],
    erw fac_aux, refl },
end

/- Lemmas `lift_strict` and `lift_continuous` separately compile *much* faster than when they are
embedded in `CompHausFiltPseuNormGrp₁.level_jointly_reflects_limits.lift`. -/
lemma lift_strict (c : ℝ≥0) (x : S.X) (hx : x ∈ pseudo_normed_group.filtration S.X c) :
  lift_fun C hC S x ∈ pseudo_normed_group.filtration C.X c :=
begin
  let y : (level.obj c).obj S.X := ⟨x,hx⟩,
  let z := (hC c).lift ((level.obj c).map_cone S) y,
  let a := ((hC (S.X.lvl x)).lift ((level.obj (S.X.lvl x)).map_cone S)) (S.X.as_lvl x),
  suffices : a.1 = z.1,
  { dsimp only [lift_fun], rw this, exact z.2, },
  let cc := c ⊔ S.X.lvl x,
  let i1 : c ⟶ cc := hom_of_le le_sup_left,
  let i2 : S.X.lvl x ⟶ cc := hom_of_le le_sup_right,
  suffices : (level.map i1).app _ z = (level.map i2).app _ a,
  { apply_fun (λ e, e.1) at this, exact this.symm },
  dsimp [a,z],
  apply concrete.is_limit_ext _ (hC cc),
  intros j,
  simp only [← CompHaus.comp_apply, category.assoc, level_cone_compatible,
    (hC c).fac_assoc, (hC (S.X.lvl x)).fac_assoc],
  ext, refl,
end

/- Lemmas `lift_strict` and `lift_continuous` separately compile *much* faster than when they are
embedded in `CompHausFiltPseuNormGrp₁.level_jointly_reflects_limits.lift`. -/
lemma lift_continuous (c : ℝ≥0) :
  continuous (pseudo_normed_group.level (lift_fun C hC S) (lift_strict C hC S) c) :=
begin
  let t : _ → (level.obj c).obj C.X := _, change continuous t,
  suffices : ∀ j, continuous (((level.obj c).map (C.π.app j)) ∘ t),
  { exact CompHaus.continuous_of_is_limit (F ⋙ level.obj c)
      ((level.obj c).map_cone C) (hC c) _ _ this },
  intros j,
  convert ((level.obj c).map (S.π.app j)).continuous,
  ext1 a,
  let cc : ℝ≥0 := c ⊔ (S.X.lvl a),
  let i1 : c ⟶ cc := hom_of_le le_sup_left,
  let i2 : (S.X.lvl a) ⟶ cc := hom_of_le le_sup_right,
  apply_fun ((level.map i1).app _), swap,
  { intros x y h, ext1, apply_fun (λ e, e.1) at h, exact h },
  simp only [← CompHaus.comp_apply],
  simp only [nat_trans.naturality],
  dsimp [t],
  generalize_proofs hh,
  let q := ((level.map i1).app C.X) (pseudo_normed_group.level (lift_fun C hC S) hh c a),
  have : q = ((level.map i2).app C.X)
    (((hC (S.X.lvl a)).lift ((level.obj (S.X.lvl a)).map_cone S)) (S.X.as_lvl a)), refl,
  dsimp only [q] at this,
  simp only [this, ← CompHaus.comp_apply, category.assoc],
  erw level_cone_compatible,
  rw (hC (S.X.lvl a)).fac_assoc,
  ext, refl,
end

/-- An auxiliary definition to be used in the constructions below. -/
def lift : S.X ⟶ C.X :=
{ to_fun      := lift_fun _ hC _,
  map_zero'   := lift_fun_map_zero _ _ _,
  map_add'    := lift_fun_map_add _ _ _,
  strict'     := lift_strict _ _ _,
  continuous' := lift_continuous _ _ _ }

end level_jointly_reflects_limits

/--
If `C` is a cone taking values in `CompHausFiltPseuNormGrp₁` such that
the restriction to all the levels is a limit cone, then `C` is a limit cone.
-/
def level_jointly_reflects_limits
  (hC : Π c : ℝ≥0, is_limit ((level.obj c).map_cone C)) :
  is_limit C :=
{ lift := λ S, level_jointly_reflects_limits.lift _ hC _,
  fac' := begin
    intros S j,
    ext1 t,
    -- `show` replaces the slower
    -- `dsimp [level_jointly_reflects_limits.lift, level_jointly_reflects_limits.lift_fun],`
    show (C.π.app j) _ = _,
    erw level_jointly_reflects_limits.fac_aux, refl,
  end,
  uniq' := begin
    intros S m hm,
    ext1 t,
    --  `dsimp [level_jointly_reflects_limits.lift, level_jointly_reflects_limits.lift_fun],`
    --  commented as it slows down the proof.  changes the goal to
    -- ⊢ m t = ((hC (S.X.lvl t)).lift ((level.obj (S.X.lvl t)).map_cone S)) (S.X.as_lvl t)
    let a :=
      ((hC (S.X.lvl t)).lift ((level.obj (S.X.lvl t)).map_cone S)) (S.X.as_lvl t),
    let c := C.X.lvl (m t),
    let d := c ⊔ (S.X.lvl t),
    let i1 : c ⟶ d := hom_of_le le_sup_left,
    let i2 : (S.X.lvl t) ⟶ d := hom_of_le le_sup_right,
    change ((level.map i1).app C.X (C.X.as_lvl (m t))).1 =
      ((level.map i2).app C.X a).1,
    congrm (subtype.val _),
    apply concrete.is_limit_ext _ (hC d), intros j,
    specialize hm j,
    ext1,
    show (C.π.app j) (m t) = (C.π.app j) _, --  `show` replaces a slow `dsimp [level, as_lvl, a]`
    erw [level_jointly_reflects_limits.fac_aux],
    rw ← hm, refl,
  end }

/-- Create a moprhism in `CompHausFiltPseuNormGrp₁` levelwise. -/
@[simps]
def create_hom_from_level {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ⟶ (level.obj c).obj Y)
  (hE0 : (E (X.lvl 0) (X.as_lvl 0)).1 = 0)
  (hEa : ∀ a b : X, (E _ (X.as_lvl (a + b))).1 =
    (E _ (X.as_lvl a)).1 + (E _ (X.as_lvl b)).1)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    E _ ≫ (level.map i).app _ = (level.map i).app _ ≫ E _) :
  X ⟶ Y :=
{ to_fun := λ x, (E _ $ X.as_lvl x).1,
  map_zero' := hE0,
  map_add' := hEa,
  strict' := begin
    intros c x hx,
    let y : (level.obj c).obj X := ⟨x,hx⟩,
    suffices : ((E (X.lvl x)) (X.as_lvl x)).val = (E _ y).1,
    { rw this, exact (E _ y).2, },
    let d := c ⊔ X.lvl x,
    let i1 : c ⟶ d := hom_of_le le_sup_left,
    let i2 : X.lvl x ⟶ d := hom_of_le le_sup_right,
    change ((level.map i2).app Y ((E (X.lvl x)) (X.as_lvl x))).1 =
      ((level.map i1).app _ _).1,
    congr' 1,
    simp only [← CompHaus.comp_apply, hE],
    refl,
  end,
  continuous' := begin
    intros c,
    let t := _, change continuous t,
    convert (E c).continuous,
    ext a,
    let d := X.lvl a ⊔ c,
    let i1 : X.lvl a ⟶ d := hom_of_le le_sup_left,
    let i2 : c ⟶ d := hom_of_le le_sup_right,
    change ((level.map i1).app _ (E _ (X.as_lvl a))).1 =
      ((level.map i2).app _ (E _ a)).1,
    simp only [← CompHaus.comp_apply, hE], refl,
  end }

lemma create_iso_from_level_compat_aux {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).hom ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).hom) :
  ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).inv ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).inv :=
begin
  intros c₁ c₂ i, rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, hE],
end

lemma create_iso_from_level_zero_aux {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y)
  (hE0 : ((E (X.lvl 0)).hom (X.as_lvl 0)).1 = 0)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).hom ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).hom) :
  ((E (Y.lvl 0)).inv (Y.as_lvl 0)).1 = 0 :=
begin
  let x := (((E (Y.lvl 0)).inv) (Y.as_lvl 0)),
  let c := Y.lvl 0 ⊔ X.lvl 0,
  let i1 : Y.lvl 0 ⟶ c := hom_of_le le_sup_left,
  let i2 : X.lvl 0 ⟶ c := hom_of_le le_sup_right,
  change ((level.map i2).app _ _).val = ((level.map i1).app _ (Y.as_lvl 0)).val at hE0,
  have hE0' := hE0,
  replace hE0 : (((level.map i2).app Y) (((E (X.lvl 0)).hom) (X.as_lvl 0))) =
    (((level.map i1).app Y) (Y.as_lvl 0)),
  { ext1, exact hE0 },
  apply_fun (E c).inv at hE0,
  simp only [← CompHaus.comp_apply, hE, category.assoc, iso.hom_inv_id] at hE0,
  apply_fun (λ e, e.val) at hE0,
  change ((level.map i1).app _ x).val = ((level.map i2).app _ (X.as_lvl 0)).val,
  dsimp only [x, ← CompHaus.comp_apply],
  rw [create_iso_from_level_compat_aux, CompHaus.comp_apply],
  exact hE0.symm,
  assumption,
end

/-- An auxiliary definition to be used in the constructions below. -/
def as_lvl_add (X : CompHausFiltPseuNormGrp₁)
  (a b : X) : (level.obj (X.lvl a + X.lvl b)).obj X :=
⟨a+b, pseudo_normed_group.add_mem_filtration (X.lvl_spec a) (X.lvl_spec b)⟩

lemma create_iso_from_level_add_aux_aux {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y) :
  ∀ (a b : X) (c : ℝ≥0)
    (h1 : X.lvl (a + b) ⟶ c)
    (h2 : X.lvl a + X.lvl b ⟶  c),
    (E c).hom ((level.map h1).app _ $ X.as_lvl _) =
    (E c).hom ((level.map h2).app _ $ X.as_lvl_add _ _) :=
begin
  intros, congr,
end

lemma create_iso_from_level_add_aux {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y)
  (hEa : ∀ a b : X, ((E _).hom (X.as_lvl (a + b))).1 =
    ((E _).hom (X.as_lvl a)).1 + ((E _).hom (X.as_lvl b)).1)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).hom ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).hom) :
  ∀ a b : Y, ((E _).inv (Y.as_lvl (a + b))).1 =
    ((E _).inv (Y.as_lvl a)).1 + ((E _).inv (Y.as_lvl b)).1 :=
begin
  intros a b,
  let a' := (((E (Y.lvl a)).inv) (Y.as_lvl a)).val,
  let b' := (((E (Y.lvl b)).inv) (Y.as_lvl b)).val,
  let ab' := (((E (Y.lvl (a + b))).inv) (Y.as_lvl (a + b))).val,
  let c₁ := Y.lvl (a + b),
  let c₂ := X.lvl a' + X.lvl b',
  let c := c₁ ⊔ c₂,
  let i1 : c₁ ⟶ c := hom_of_le le_sup_left,
  let i2 : c₂ ⟶ c := hom_of_le le_sup_right,
  change ((level.map i1).app _ _).val = ((level.map i2).app _ $ X.as_lvl_add a' b').val,
  congr' 1,
  rw [← CompHaus.comp_apply, create_iso_from_level_compat_aux _ hE],
  apply_fun (E _).hom,
  swap, { apply CompHaus.injective_of_is_iso },
  simp only [← CompHaus.comp_apply, category.assoc, iso.inv_hom_id],
  simp only [CompHaus.comp_apply, CompHaus.id_apply],
  let d := X.lvl (a' + b') ⊔ c,
  let j1 : X.lvl (a' + b') ⟶ d := hom_of_le le_sup_left,
  let j2 : c ⟶ d := hom_of_le le_sup_right,
  apply_fun (level.map j2).app _,
  swap, { intros x y h, ext1, apply_fun (λ e, e.val) at h, exact h },
  simp only [← CompHaus.comp_apply, category.assoc, hE, ← nat_trans.comp_app],
  rw [← category.assoc, ← nat_trans.comp_app, ← functor.map_comp, ← functor.map_comp,
    CompHaus.comp_apply],
  erw create_iso_from_level_add_aux_aux,
  any_goals { assumption },
  swap, refine i2 ≫ j2,
  simp only [functor.map_comp, nat_trans.comp_app, CompHaus.comp_apply],
  let s := _, change _ = (E d).hom s,
  have : s = (level.map j1).app _ (X.as_lvl (a' + b')), by { ext, refl },
  rw this, clear this,
  simp_rw [← CompHaus.comp_apply, ← hE, CompHaus.comp_apply],
  ext1,
--  `show` replaces the `slower `dsimp [level]`
  show ↑(Y.as_lvl _) = ↑(((E (X.lvl (a' + b'))).hom) (X.as_lvl (a' + b'))),
--  show replaces the slower `conv_lhs { dsimp [as_lvl] }`
  show a + b = _,
  rw [← subtype.val_eq_coe, hEa a' b'],
  congrm _ + _,
  { let d₁ := Y.lvl a,
    let d₂ := X.lvl a',
    let d := d₁ ⊔ d₂,
    let e₁ : d₁ ⟶ d := hom_of_le le_sup_left,
    let e₂ : d₂ ⟶ d := hom_of_le le_sup_right,
    change ((level.map e₁).app _ (Y.as_lvl a)).val =
      ((level.map e₂).app _ (((E (X.lvl a')).hom) (X.as_lvl a'))).val,
    rw [← CompHaus.comp_apply, hE],
    congr' 1,
    apply_fun (E d).inv,
    swap, { apply CompHaus.injective_of_is_iso },
    simp_rw [← CompHaus.comp_apply, category.assoc, iso.hom_inv_id],
    rw ← create_iso_from_level_compat_aux,
    ext, refl,
    assumption },
  { let d₁ := Y.lvl b,
    let d₂ := X.lvl b',
    let d := d₁ ⊔ d₂,
    let e₁ : d₁ ⟶ d := hom_of_le le_sup_left,
    let e₂ : d₂ ⟶ d := hom_of_le le_sup_right,
    change ((level.map e₁).app _ (Y.as_lvl b)).val =
      ((level.map e₂).app _ (((E (X.lvl b')).hom) (X.as_lvl b'))).val,
    rw [← CompHaus.comp_apply, hE],
    congr' 1,
    apply_fun (E d).inv,
    swap, { apply CompHaus.injective_of_is_iso },
    simp_rw [← CompHaus.comp_apply, category.assoc, iso.hom_inv_id],
    rw ← create_iso_from_level_compat_aux,
    ext, refl,
    assumption }
end

/-- Create an isomoprhism in `CompHausFiltPseuNormGrp₁` levelwise. -/
def create_iso_from_level {X Y : CompHausFiltPseuNormGrp₁.{u}}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y)
  (hE0 : ((E (X.lvl 0)).hom (X.as_lvl 0)).1 = 0)
  (hEa : ∀ a b : X, ((E _).hom (X.as_lvl (a + b))).1 =
    ((E _).hom (X.as_lvl a)).1 + ((E _).hom (X.as_lvl b)).1)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).hom ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).hom) :
  X ≅ Y :=
{ hom := create_hom_from_level (λ c, (E c).hom) hE0 hEa hE,
  inv := create_hom_from_level (λ c, (E c).inv)
    (create_iso_from_level_zero_aux _ hE0 hE)
    (create_iso_from_level_add_aux _ hEa hE)
    (create_iso_from_level_compat_aux _ hE),
  hom_inv_id' := begin
    ext1 t,
    simp only [comp_apply, create_hom_from_level_to_fun, subtype.val_eq_coe, id_apply],
    let s := (((E (X.lvl t)).hom) (X.as_lvl t)).val,
    let c₁ := Y.lvl s,
    let c₂ := X.lvl t,
    let c := c₁ ⊔ c₂,
    let i1 : c₁ ⟶ c := hom_of_le le_sup_left,
    let i2 : c₂ ⟶ c := hom_of_le le_sup_right,
    change ((level.map i1).app _ _).val = ((level.map i2).app _ (X.as_lvl t)).val,
    simp only [← CompHaus.comp_apply],
    rw create_iso_from_level_compat_aux,
    any_goals { assumption },
    simp only [CompHaus.comp_apply],
    congr' 1,
    apply_fun (E c).hom,
    swap,
    { intros x y h,
      apply_fun (E c).inv at h,
      simp only [← CompHaus.comp_apply, iso.hom_inv_id] at h,
      exact h },
    rw [← CompHaus.comp_apply, iso.inv_hom_id, CompHaus.id_apply],
    rw [← CompHaus.comp_apply, ← hE],
    refl,
  end,
  inv_hom_id' := begin
    ext1 t,
    simp only [comp_apply, create_hom_from_level_to_fun, subtype.val_eq_coe, id_apply],
    let s := (((E (Y.lvl t)).inv) (Y.as_lvl t)).val,
    let c₁ := X.lvl s,
    let c₂ := Y.lvl t,
    let c := c₁ ⊔ c₂,
    let i1 : c₁ ⟶ c := hom_of_le le_sup_left,
    let i2 : c₂ ⟶ c := hom_of_le le_sup_right,
    change ((level.map i1).app _ _).val = ((level.map i2).app _ (Y.as_lvl t)).val,
    simp only [← CompHaus.comp_apply],
    rw hE,
    simp only [CompHaus.comp_apply],
    congr' 1,
    apply_fun (E c).inv,
    swap,
    { intros x y h,
      apply_fun (E c).hom at h,
      simp only [← CompHaus.comp_apply, iso.inv_hom_id] at h,
      exact h },
    rw [← CompHaus.comp_apply, iso.hom_inv_id, CompHaus.id_apply],
    rw [← CompHaus.comp_apply, ← create_iso_from_level_compat_aux],
    any_goals { assumption },
    refl,
  end }

lemma level_create_iso_from_level {X Y : CompHausFiltPseuNormGrp₁}
  (E : Π c, (level.obj c).obj X ≅ (level.obj c).obj Y)
  (hE0 : ((E (X.lvl 0)).hom (X.as_lvl 0)).1 = 0)
  (hEa : ∀ a b : X, ((E _).hom (X.as_lvl (a + b))).1 =
    ((E _).hom (X.as_lvl a)).1 + ((E _).hom (X.as_lvl b)).1)
  (hE : ∀ (c₁ c₂ : ℝ≥0) (i : c₁ ⟶ c₂),
    (E _).hom ≫ (level.map i).app _ = (level.map i).app _ ≫ (E _).hom) (c) :
  (level.obj c).map
  (create_iso_from_level E hE0 hEa hE).hom = (E _).hom :=
begin
  ext t,
  --  `dsimp [create_iso_from_level, create_hom_from_level, level],` -- changes the goal to
  -- ⊢ ↑(⇑((E (X.lvl ↑t)).hom) (X.as_lvl ↑t)) = ↑(⇑((E c).hom) t)
  -- but is not needed and slows down the proof.
  let d := X.lvl t.1 ⊔ c,
  let i1 : X.lvl t.1 ⟶ d := hom_of_le le_sup_left,
  let i2 : c ⟶ d := hom_of_le le_sup_right,
  change ((level.map i1).app _ _).val =
    ((level.map i2).app _ _).val,
  congr' 1,
  simp only [← CompHaus.comp_apply, hE], ext, refl
end

lemma level_jointly_faithful {X Y : CompHausFiltPseuNormGrp₁} (f g : X ⟶ Y)
  (h : ∀ c, (level.obj c).map f = (level.obj c).map g) : f = g :=
begin
  ext t,
  specialize h (X.lvl t),
  apply_fun (λ e, (e (X.as_lvl t)).1) at h,
  exact h
end

end CompHausFiltPseuNormGrp₁