/-
Copyright (c) 2022 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno
-/
import category_theory.bicategory.functor

/-!
# Free bicategories

We define the free bicategory over a quiver. In this bicategory, the 1-morphisms are freely
generated by the arrows in the quiver, and the 2-morphisms are freely generated by the formal
identities, the formal unitors, and the formal associators modulo the relation derived from the
axioms of a bicategory.

## Main definitions

* `free_bicategory B`: the free bicategory over a quiver `B`.
* `free_bicategory.lift F`: the pseudofunctor from `free_bicategory B` to `C` associated with a
  prefunctor `F` from `B` to `C`.
-/

universes w w₁ w₂ v v₁ v₂ u u₁ u₂

namespace category_theory
open category bicategory
open_locale bicategory

/-- Free bicategory over a quiver. Its objects are the same as those in the underlying quiver. -/
def free_bicategory (B : Type u) := B

instance (B : Type u) : Π [inhabited B], inhabited (free_bicategory B) := id

namespace free_bicategory

section
variables {B : Type u} [quiver.{v+1} B]

/-- 1-morphisms in the free bicategory. -/
inductive hom : B → B → Type (max u v)
| of {a b : B} (f : a ⟶ b) : hom a b
| id (a : B) : hom a a
| comp {a b c : B} (f : hom a b) (g : hom b c) : hom a c

instance (a b : B) [inhabited (a ⟶ b)] : inhabited (hom a b) := ⟨hom.of default⟩

/-- Representatives of 2-morphisms in the free bicategory. -/
@[nolint has_inhabited_instance]
inductive hom₂ : Π {a b : B}, hom a b → hom a b → Type (max u v)
| id {a b} (f : hom a b) : hom₂ f f
| vcomp {a b} {f g h : hom a b} (η : hom₂ f g) (θ : hom₂ g h) : hom₂ f h
| whisker_left {a b c} (f : hom a b) {g h : hom b c} (η : hom₂ g h) : hom₂ (f.comp g) (f.comp h)
-- `η` cannot be earlier than `h` since it is a recursive argument.
| whisker_right {a b c} {f g : hom a b} (h : hom b c) (η : hom₂ f g) : hom₂ (f.comp h) (g.comp h)
| associator {a b c d} (f : hom a b) (g : hom b c) (h : hom c d) :
    hom₂ ((f.comp g).comp h) (f.comp (g.comp h))
| associator_inv {a b c d} (f : hom a b) (g : hom b c) (h : hom c d) :
    hom₂ (f.comp (g.comp h)) ((f.comp g).comp h)
| right_unitor     {a b} (f : hom a b) : hom₂ (f.comp (hom.id b)) f
| right_unitor_inv {a b} (f : hom a b) : hom₂ f (f.comp (hom.id b))
| left_unitor      {a b} (f : hom a b) : hom₂ ((hom.id a).comp f) f
| left_unitor_inv  {a b} (f : hom a b) : hom₂ f ((hom.id a).comp f)

section
variables {B}

-- The following notations are only used in the definition of `rel` to simplify the notation.
local infixr ` ≫ ` := hom₂.vcomp
local notation `𝟙` := hom₂.id
local notation f ` ◁ ` η := hom₂.whisker_left f η
local notation η ` ▷ ` h := hom₂.whisker_right h η
local notation `α_` := hom₂.associator
local notation `λ_` := hom₂.left_unitor
local notation `ρ_` := hom₂.right_unitor
local notation `α⁻¹_` := hom₂.associator_inv
local notation `λ⁻¹_` := hom₂.left_unitor_inv
local notation `ρ⁻¹_` := hom₂.right_unitor_inv

/-- Relations between 2-morphisms in the free bicategory. -/
inductive rel : Π {a b : B} {f g : hom a b}, hom₂ f g → hom₂ f g → Prop
| vcomp_right {a b} {f g h : hom a b} (η : hom₂ f g) (θ₁ θ₂ : hom₂ g h) :
    rel θ₁ θ₂ → rel (η ≫ θ₁) (η ≫ θ₂)
| vcomp_left {a b} {f g h : hom a b} (η₁ η₂ : hom₂ f g) (θ : hom₂ g h) :
    rel η₁ η₂ → rel (η₁ ≫ θ) (η₂ ≫ θ)
| id_comp {a b} {f g : hom a b} (η : hom₂ f g) :
    rel (𝟙 f ≫ η) η
| comp_id {a b} {f g : hom a b} (η : hom₂ f g) :
    rel (η ≫ 𝟙 g) η
| assoc {a b} {f g h i : hom a b} (η : hom₂ f g) (θ : hom₂ g h) (ι : hom₂ h i) :
    rel ((η ≫ θ) ≫ ι) (η ≫ (θ ≫ ι))
| whisker_left {a b c} (f : hom a b) (g h : hom b c) (η η' : hom₂ g h) :
    rel η η' → rel (f ◁ η) (f ◁ η')
| whisker_left_id {a b c} (f : hom a b) (g : hom b c) :
    rel (f ◁ 𝟙 g) (𝟙 (f.comp g))
| whisker_left_comp {a b c} (f : hom a b) {g h i : hom b c} (η : hom₂ g h) (θ : hom₂ h i) :
    rel (f ◁ (η ≫ θ)) (f ◁ η ≫ f ◁ θ)
| id_whisker_left {a b} {f g : hom a b} (η : hom₂ f g) :
    rel (hom.id a ◁ η) (λ_ f ≫ η ≫ λ⁻¹_ g)
| comp_whisker_left
    {a b c d} (f : hom a b) (g : hom b c) {h h' : hom c d} (η : hom₂ h h') :
    rel ((f.comp g) ◁ η) (α_ f g h ≫ f ◁ g ◁ η ≫ α⁻¹_ f g h')
| whisker_right {a b c} (f g : hom a b) (h : hom b c) (η η' : hom₂ f g) :
    rel η η' → rel (η ▷ h) (η' ▷ h)
| id_whisker_right {a b c} (f : hom a b) (g : hom b c) :
    rel (𝟙 f ▷ g) (𝟙 (f.comp g))
| comp_whisker_right {a b c} {f g h : hom a b} (i : hom b c) (η : hom₂ f g) (θ : hom₂ g h) :
    rel ((η ≫ θ) ▷ i) (η ▷ i ≫ θ ▷ i)
| whisker_right_id {a b} {f g : hom a b} (η : hom₂ f g) :
    rel (η ▷ hom.id b) (ρ_ f ≫ η ≫ ρ⁻¹_ g)
| whisker_right_comp
    {a b c d} {f f' : hom a b} (g : hom b c) (h : hom c d) (η : hom₂ f f') :
    rel (η ▷ (g.comp h)) (α⁻¹_ f g h ≫ η ▷ g ▷ h ≫ α_ f' g h)
| whisker_assoc
    {a b c d} (f : hom a b) {g g' : hom b c} (η : hom₂ g g') (h : hom c d) :
    rel ((f ◁ η) ▷ h) (α_ f g h ≫ f ◁ (η ▷ h)≫ α⁻¹_ f g' h)
| whisker_exchange {a b c} {f g : hom a b} {h i : hom b c} (η : hom₂ f g) (θ : hom₂ h i) :
    rel (f ◁ θ ≫ η ▷ i) (η ▷ h ≫ g ◁ θ)
| associator_hom_inv {a b c d} (f : hom a b) (g : hom b c) (h : hom c d) :
    rel (α_ f g h ≫ α⁻¹_ f g h) (𝟙 ((f.comp g).comp h))
| associator_inv_hom {a b c d} (f : hom a b) (g : hom b c) (h : hom c d) :
    rel (α⁻¹_ f g h ≫ α_ f g h) (𝟙 (f.comp (g.comp h)))
| left_unitor_hom_inv {a b} (f : hom a b) :
    rel (λ_ f ≫ λ⁻¹_ f) (𝟙 ((hom.id a).comp f))
| left_unitor_inv_hom {a b} (f : hom a b) :
    rel (λ⁻¹_ f ≫ λ_ f) (𝟙 f)
| right_unitor_hom_inv {a b} (f : hom a b) :
    rel (ρ_ f ≫ ρ⁻¹_ f) (𝟙 (f.comp (hom.id b)))
| right_unitor_inv_hom {a b} (f : hom a b) :
    rel (ρ⁻¹_ f ≫ ρ_ f) (𝟙 f)
| pentagon {a b c d e} (f : hom a b) (g : hom b c) (h : hom c d) (i : hom d e) :
    rel (α_ f g h ▷ i ≫ α_ f (g.comp h) i ≫ f ◁ α_ g h i)
        (α_ (f.comp g) h i ≫ α_ f g (h.comp i))
| triangle {a b c} (f : hom a b) (g : hom b c) :
    rel (α_ f (hom.id b) g ≫ f ◁ λ_ g) (ρ_ f ▷ g)

end

variables {B}

instance hom_category (a b : B) : category (hom a b) :=
{ hom       := λ f g, quot (@rel _ _ _ _ f g),
  id        := λ f, quot.mk rel (hom₂.id f),
  comp      := λ f g h, quot.map₂ hom₂.vcomp rel.vcomp_right rel.vcomp_left,
  id_comp'  := by { rintros f g ⟨η⟩, exact quot.sound (rel.id_comp η) },
  comp_id'  := by { rintros f g ⟨η⟩, exact quot.sound (rel.comp_id η) },
  assoc'    := by { rintros f g h i ⟨η⟩ ⟨θ⟩ ⟨ι⟩, exact quot.sound (rel.assoc η θ ι) } }

/-- Bicategory structure on the free bicategory. -/
instance bicategory : bicategory (free_bicategory B) :=
{ hom   := λ a b : B, hom a b,
  id    := hom.id,
  comp  := λ a b c, hom.comp,
  hom_category := free_bicategory.hom_category,
  whisker_left := λ a b c f g h η,
    quot.map (hom₂.whisker_left f) (rel.whisker_left f g h) η,
  whisker_left_id' := λ a b c f g, quot.sound (rel.whisker_left_id f g),
  whisker_left_comp' := by
  { rintros a b c f g h i ⟨η⟩ ⟨θ⟩, exact quot.sound (rel.whisker_left_comp f η θ) },
  id_whisker_left' := by
  { rintros a b f g ⟨η⟩, exact quot.sound (rel.id_whisker_left η) },
  comp_whisker_left' := by
  { rintros a b c d f g h h' ⟨η⟩, exact quot.sound (rel.comp_whisker_left f g η) },
  whisker_right := λ a b c f g η h,
    quot.map (hom₂.whisker_right h) (rel.whisker_right f g h) η,
  id_whisker_right' := λ a b c f g, quot.sound (rel.id_whisker_right f g),
  comp_whisker_right' := by
  { rintros a b c f g h ⟨η⟩ ⟨θ⟩ i, exact quot.sound (rel.comp_whisker_right i η θ) },
  whisker_right_id' := by
  { rintros a b f g ⟨η⟩, exact quot.sound (rel.whisker_right_id η) },
  whisker_right_comp' := by
  { rintros a b c d f f' ⟨η⟩ g h, exact quot.sound (rel.whisker_right_comp g h η) },
  whisker_assoc' := by
  { rintros a b c d f g g' ⟨η⟩ h, exact quot.sound (rel.whisker_assoc f η h) },
  whisker_exchange' := by
  { rintros a b c f g h i ⟨η⟩ ⟨θ⟩, exact quot.sound (rel.whisker_exchange η θ) },
  associator := λ a b c d f g h,
  { hom := quot.mk rel (hom₂.associator f g h),
    inv := quot.mk rel (hom₂.associator_inv f g h),
    hom_inv_id' := quot.sound (rel.associator_hom_inv f g h),
    inv_hom_id' := quot.sound (rel.associator_inv_hom f g h) },
  left_unitor := λ a b f,
  { hom := quot.mk rel (hom₂.left_unitor f),
    inv := quot.mk rel (hom₂.left_unitor_inv f),
    hom_inv_id' := quot.sound (rel.left_unitor_hom_inv f),
    inv_hom_id' := quot.sound (rel.left_unitor_inv_hom f) },
  right_unitor := λ a b f,
  { hom := quot.mk rel (hom₂.right_unitor f),
    inv := quot.mk rel (hom₂.right_unitor_inv f),
    hom_inv_id' := quot.sound (rel.right_unitor_hom_inv f),
    inv_hom_id' := quot.sound (rel.right_unitor_inv_hom f) },
  pentagon' := λ a b c d e f g h i, quot.sound (rel.pentagon f g h i),
  triangle' := λ a b c f g, quot.sound (rel.triangle f g) }

variables {a b c d : free_bicategory B}

@[simp] lemma mk_vcomp {f g h : a ⟶ b} (η : hom₂ f g) (θ : hom₂ g h) :
  quot.mk rel (η.vcomp θ) = (quot.mk rel η ≫ quot.mk rel θ : f ⟶ h) := rfl
@[simp] lemma mk_whisker_left (f : a ⟶ b) {g h : b ⟶ c} (η : hom₂ g h) :
  quot.mk rel (hom₂.whisker_left f η) = (f ◁ quot.mk rel η : f ≫ g ⟶ f ≫ h) := rfl
@[simp] lemma mk_whisker_right {f g : a ⟶ b} (η : hom₂ f g) (h : b ⟶ c) :
  quot.mk rel (hom₂.whisker_right h η) = (quot.mk rel η ▷ h : f ≫ h ⟶ g ≫ h) := rfl

variables (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d)

lemma id_def : hom.id a = 𝟙 a := rfl
lemma comp_def : hom.comp f g = f ≫ g := rfl
@[simp] lemma mk_id : quot.mk _ (hom₂.id f) = 𝟙 f := rfl
@[simp] lemma mk_associator_hom : quot.mk _ (hom₂.associator f g h) = (α_ f g h).hom := rfl
@[simp]

/-- Canonical prefunctor from `B` to `free_bicategory B`. -/
@[simps]
def of : prefunctor B (free_bicategory B) :=
{ obj := id,
  map := λ a b, hom.of }

end

section
variables {B : Type u₁} [quiver.{v₁+1} B] {C : Type u₂} [category_struct.{v₂} C]
variables (F : prefunctor B C)

/-- Auxiliary definition for `lift`. -/
@[simp]
def lift_hom : ∀ {a b : B}, hom a b → (F.obj a ⟶ F.obj b)
| _ _ (hom.of f)      := F.map f
| _ _ (hom.id a)      := 𝟙 (F.obj a)
| _ _ (hom.comp f g)  := lift_hom f ≫ lift_hom g

@[simp] lemma lift_hom_id (a : free_bicategory B) : lift_hom F (𝟙 a) = 𝟙 (F.obj a) := rfl
@[simp] lemma lift_hom_comp {a b c : free_bicategory B} (f : a ⟶ b) (g : b ⟶ c) :
  lift_hom F (f ≫ g) = lift_hom F f ≫ lift_hom F g := rfl

end

section
variables {B : Type u₁} [quiver.{v₁+1} B] {C : Type u₂} [bicategory.{w₂ v₂} C]
variables (F : prefunctor B C)

/-- Auxiliary definition for `lift`. -/
@[simp]
def lift_hom₂ : ∀ {a b : B} {f g : hom a b}, hom₂ f g → (lift_hom F f ⟶ lift_hom F g)
| _ _ _ _ (hom₂.id _)                   := 𝟙 _
| _ _ _ _ (hom₂.associator _ _ _)       := (α_ _ _ _).hom
| _ _ _ _ (hom₂.associator_inv _ _ _)   := (α_ _ _ _).inv
| _ _ _ _ (hom₂.left_unitor _)          := (λ_ _).hom
| _ _ _ _ (hom₂.left_unitor_inv _)      := (λ_ _).inv
| _ _ _ _ (hom₂.right_unitor _)         := (ρ_ _).hom
| _ _ _ _ (hom₂.right_unitor_inv _)     := (ρ_ _).inv
| _ _ _ _ (hom₂.vcomp η θ)              := lift_hom₂ η ≫ lift_hom₂ θ
| _ _ _ _ (hom₂.whisker_left f η)       := lift_hom F f ◁ lift_hom₂ η
| _ _ _ _ (hom₂.whisker_right h η)      := lift_hom₂ η ▷ lift_hom F h

local attribute [simp] whisker_exchange

lemma lift_hom₂_congr {a b : B} {f g : hom a b} {η θ : hom₂ f g} (H : rel η θ) :
  lift_hom₂ F η = lift_hom₂ F θ :=
by induction H; tidy

/--
A prefunctor from a quiver `B` to a bicategory `C` can be lifted to a pseudofunctor from
`free_bicategory B` to `C`.
-/
@[simps]
def lift : pseudofunctor (free_bicategory B) C :=
{ obj       := F.obj,
  map       := λ a b, lift_hom F,
  map₂      := λ a b f g, quot.lift (lift_hom₂ F) (λ η θ H, lift_hom₂_congr F H),
  map_id    := λ a, iso.refl _,
  map_comp  := λ a b c f g, iso.refl _ }

end

end free_bicategory

end category_theory


/-
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 for_mathlib.dold_kan.normalized

/-!

# The normalized Moore complex and the alternating face map complex are homotopy equivalent

In this file, when the category `A` is abelian, we obtain the homotopy equivalence
`homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex` between the
normalized Moore complex and the alternating face map complex of a simplicial object in `A`.

-/

open category_theory category_theory.category category_theory.limits
  category_theory.preadditive
open_locale simplicial dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] (X : simplicial_object C)

/-- Inductive construction of homotopies from `P q` to `𝟙 _` -/
noncomputable def homotopy_P_to_id : Π (q : ℕ),
  homotopy (P q : K[X] ⟶ _) (𝟙 _)
| 0     := homotopy.refl _
| (q+1) := begin
    refine homotopy.trans (homotopy.of_eq _)
      (homotopy.trans
        (homotopy.add (homotopy_P_to_id q) (homotopy.comp_left (homotopy_Hσ_to_zero q) (P q)))
        (homotopy.of_eq _)),
    { unfold P, simp only [comp_add, comp_id], },
    { simp only [add_zero, comp_zero], },
  end

/-- The complement projection `Q q` to `P q` is homotopic to zero. -/
def homotopy_Q_to_zero (q : ℕ) : homotopy (Q q : K[X] ⟶ _) 0 :=
homotopy.equiv_sub_zero.to_fun (homotopy_P_to_id X q).symm

lemma homotopy_P_to_id_eventually_constant {q n : ℕ} (hqn : n<q):
  ((homotopy_P_to_id X (q+1)).hom n (n+1) : X _[n] ⟶ X _[n+1]) =
  (homotopy_P_to_id X q).hom n (n+1) :=
begin
  unfold homotopy_P_to_id,
  simp only [homotopy_Hσ_to_zero, hσ'_eq_zero hqn (c_mk (n+1) n rfl), homotopy.trans_hom,
    pi.add_apply, homotopy.of_eq_hom, pi.zero_apply, homotopy.add_hom, homotopy.comp_left_hom,
    homotopy.null_homotopy'_hom, complex_shape.down_rel, eq_self_iff_true, dite_eq_ite,
    if_true, comp_zero, add_zero, zero_add],
end

variable (X)

/-- Construction of the homotopy from `P_infty` to the identity using eventually
(termwise) constant homotopies from `P q` to the identity for all `q` -/
@[simps]
def homotopy_P_infty_to_id :
  homotopy (P_infty : K[X] ⟶ _) (𝟙 _) :=
{ hom := λ i j, (homotopy_P_to_id X (j+1)).hom i j,
  zero' := λ i j hij, homotopy.zero _ i j hij,
  comm := λ n, begin
    cases n,
    { simpa only [homotopy.d_next_zero_chain_complex, homotopy.prev_d_chain_complex,  P_f_0_eq,
        zero_add, homological_complex.id_f, P_infty_f] using (homotopy_P_to_id X 2).comm 0, },
    { simpa only [homotopy.d_next_succ_chain_complex, homotopy.prev_d_chain_complex,
        homological_complex.id_f, P_infty_f, ← P_is_eventually_constant (rfl.le : n+1 ≤ n+1),
        homotopy_P_to_id_eventually_constant X (lt_add_one (n+1))]
        using (homotopy_P_to_id X (n+2)).comm (n+1), },
  end }

/-- The inclusion of the Moore complex in the alternating face map complex
is an homotopy equivalence -/
@[simps]
def homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex {A : Type*}
  [category A] [abelian A] {Y : simplicial_object A} :
  homotopy_equiv ((normalized_Moore_complex A).obj Y) ((alternating_face_map_complex A).obj Y) :=
{ hom := inclusion_of_Moore_complex_map Y,
  inv := P_infty_to_normalized_Moore_complex Y,
  homotopy_hom_inv_id := homotopy.of_eq (split_mono_inclusion_of_Moore_complex_map Y).id,
  homotopy_inv_hom_id := homotopy.trans
    (homotopy.of_eq (P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map Y))
    (homotopy_P_infty_to_id Y), }

end dold_kan

end algebraic_topology


import function.misc
import function.bijection
import data.finord
import .misc

namespace list

--- Turn a list `l` into a function from the set of members to the indices in `finord`.
protected
definition indexer {α : Type _} [decidable_eq α] (l : list α) : {x // x ∈ l} → finord l.length :=
  list.rec_on l
    (λ x, false.elim (not_mem_nil _ x.property))
    (λ a tl f x,
      dite (x.val=a) (λ _, finord.fz) $ λ h,
        finord.fs (f ⟨x.val, or.resolve_left x.property h⟩)
    )

@[simp]
protected
lemma indexer_cons_eq {α : Type _} [decidable_eq α] {a : α} {tl : list α} : ∀ {x : {x // x ∈ a :: tl}}, x.val = a → list.indexer (a :: tl) x = finord.fz :=
  begin
    intros x hx,
    cases x; dsimp * at *,
    dsimp [list.indexer]; rw [dif_pos hx]
  end

@[simp]
protected
lemma indexer_cons_neq {α : Type _} [decidable_eq α] {a : α} {tl : list α} {x : {x // x ∈ a :: tl}} (hx : x.val ≠ a) : list.indexer (a :: tl) x = finord.fs (tl.indexer ⟨x.val,or.resolve_left x.property hx⟩) :=
  begin
    cases x; dsimp * at *,
    dsimp [list.indexer]; rw [dif_neg hx]
  end

--- `l.indexer` is surjective provided `l.nodup`.
protected
lemma indexer_surjective {α : Type _} [decidable_eq α] {l : list α} : l.nodup → function.surjective l.indexer :=
  begin
    intros hnodup k,
    induction l with a tl h_ind,
    case nil { cases k },
    case cons {
      cases k with _ _ j,
      case fz {
        refine ⟨⟨a,or.inl rfl⟩,_⟩,
        dsimp [list.indexer],
        rw [dif_pos rfl]
      },
      case fs {
        cases h_ind (nodup_tail hnodup) j with x hx,
        existsi @subtype.mk α (λ x, x ∈ a :: tl) x.val (mem_cons_of_mem a x.property),
        have : x.val ≠ a, {
          intros hxa,
          cases hnodup with _ _ hatl _ _,
          exact hatl (hxa ▸ x.property)
        },
        refine eq.trans (list.indexer_cons_neq this) _,
        apply congr_arg finord.fs,
        refine eq.trans (congr_arg tl.indexer _) hx,
        exact subtype.eq rfl
      }
    }
  end

--- Convert a list `l` into a function from the set of indices of type `finord`.
protected
definition enumerator {α : Type _} : Π (l : list α), finord (length l) → α
| (x::xs) finord.fz := x
| (x::xs) (finord.fs n) := enumerator xs n

--- Every value of `l.to_fun` is a member of the original list `l`.
protected
lemma mem_of_enumerated {α : Type _} (l : list α) : ∀ x, l.enumerator x ∈ l :=
  begin
    intros x,
    induction l with a tl h_ind,
    case nil { cases x },
    case cons {
      dsimp [list.length] at x,
      cases x with _ _ x',
      case fz {
        dsimp [list.enumerator],
        exact or.inl rfl
      },
      case fs {
        dsimp [list.enumerator],
        exact or.inr (h_ind x')
      }
    }
  end

--- The same as `list.enumerator` while the codomain is restricted to the subtype of members of the given list.
protected
definition subenumerator {α : Type _} (l : list α) : finord l.length → {x  // x ∈ l} :=
  λ n, ⟨l.enumerator n, l.mem_of_enumerated _⟩

--- Every member of a list `l` appears as a value of the function `l.enumerator`.
protected
lemma enumerate_mem {α : Type _} (l : list α) {x : α} : x ∈ l → ∃ n, x = l.enumerator n :=
  begin
    intros hx,
    induction l with a tl h_ind,
    case nil { exfalso; exact not_mem_nil _ hx },
    case cons {
      cases hx,
      case or.inl { exact ⟨finord.fz, hx⟩ },
      case or.inr {
        cases h_ind hx with n hn,
        exact ⟨n.fs, hn⟩,
      }
    }
  end

--- `l.enumerator` is an injective function provided `l.nodup`.
protected
lemma enumerator_injective {α : Type _} {l : list α} : l.nodup → function.injective l.enumerator :=
  begin
    intros hnodup x y hxy,
    induction l with a tl h_ind,
    case nil { cases x },
    cases x with _ _ x',
    case fz {
      dsimp [list.enumerator] at *,
      cases y with _ _ y',
      case fz { refl },
      case fs {
        dsimp [list.enumerator] at hxy,
        have : a ∈ tl,
          by rw [hxy]; exact tl.mem_of_enumerated y',
        exfalso,
        exact nodup_head hnodup this,
      }
    },
    case fs {
      cases y with _ _ y',
      case fz {
        dsimp [list.enumerator] at hxy,
        have : a ∈ tl,
          by rw [←hxy]; exact tl.mem_of_enumerated x',
        exfalso,
        exact nodup_head hnodup this
      },
      case fs {
        apply congr_arg finord.fs,
        dsimp [list.enumerator] at hxy,
        exact h_ind (nodup_tail hnodup) hxy,
      },
    }
  end

--- Conver a function out of a finite set into a list of values.
protected
definition from_fun {α : Type _} : Π {n : ℕ} (f : finord n → α), list α
| 0 _ := []
| (k+1) f := f finord.fz :: @from_fun k (f∘ finord.fs)

--- `list.from_fun` maps equivalent functions into the same list.
protected
lemma from_fun_equiv {α : Type _} {n : ℕ} : ∀ {f g : finord n → α}, (∀ x, f x = g x) → list.from_fun f = list.from_fun g :=
  begin
    induction n with n h_ind,
    case zero { intros; refl },
    case succ {
      intros f g hfg,
      dsimp [list.from_fun],
      rw [hfg],
      refine congr_arg (list.cons (g _)) (h_ind _),
      intros x,
      dsimp [function.comp],
      exact hfg _
    }
  end

--- The value list of `l.enumerator` is exactly the original list `l`.
protected
lemma from_enumerator {α : Type _} (l : list α) : list.from_fun l.enumerator = l :=
  begin
    induction l with a tl h_ind,
    case nil { refl },
    dsimp [list.enumerator,list.from_fun] at *,
    apply congr_arg (list.cons a),
    refine eq.trans _ h_ind,
    apply list.from_fun_equiv,
    intros x,
    dsimp [list.enumerator]; refl
  end

--- The length of the value list equals the cardinality of the domain.
protected
lemma length_of_from_fun {α : Type _} {n : ℕ} : ∀ (f : finord n → α), (list.from_fun f).length = n :=
  begin
    induction n with k h_ind,
    case zero { intros; refl },
    case succ {
      intros f,
      dsimp [list.from_fun],
      exact congr_arg nat.succ (h_ind _),
    }
  end

/- Composition of `l.indexer` and `l.enumerator` -/
section

variables {α : Type _} [decidable_eq α] {l : list α}

--- The members of a list can be enumerated by their indices.
@[simp]
protected
theorem enumerate_index : ∀ x, l.enumerator (l.indexer x) = x.val :=
  begin
    intros x; cases x with x hx,
    induction l with a tl h_ind,
    case nil { exfalso; exact list.not_mem_nil _ hx },
    refine dite (x=a) _ _,
    show x = a → _, {
      intros hxa,
      have : ∀ {h}, (a :: tl).indexer ⟨x,h⟩ = finord.fz,
        from λ h, list.indexer_cons_eq hxa,
      rw [this],
      dsimp [list.enumerator],
      exact hxa.symm
    },
    show x ≠ a → _, {
      intros hxa,
      have : ∀ {h}, (a :: tl).indexer ⟨x,h⟩ = finord.fs (tl.indexer ⟨x,_⟩),
        from λ h, list.indexer_cons_neq hxa,
      rw [this],
      dsimp [list.enumerator],
      exact h_ind (or.resolve_left hx hxa)
    },
  end

--- For every `l : list α`, `l.subenumerator` is always a left inverse to `l.indexer`.
@[simp]
theorem subenumerator_left_inverse_of_indexer : function.left_inverse l.subenumerator l.indexer :=
  begin
    intros x,
    dunfold list.subenumerator,
    apply subtype.eq,
    exact list.enumerate_index x
  end

--- For every `l : list α`, `l.indexer` is a left inverse to `l.subenumerator` provided `l.nodup`.
@[simp]
theorem indexer_left_inverse_of_subenumerator : l.nodup → function.left_inverse l.indexer l.subenumerator :=
  begin
    intros hnodup x,
    induction l with a tl h_ind,
    case nil { cases x },
    case cons {
      cases x with _ _ n,
      case fz {
        dsimp [list.subenumerator,list.enumerator],
        exact list.indexer_cons_eq rfl
      },
      case fs {
        dsimp [list.subenumerator,list.enumerator],
        have : tl.enumerator n ≠ a, {
          intros ha,
          exact nodup_head hnodup (ha ▸ tl.mem_of_enumerated n)
        },
        refine eq.trans (list.indexer_cons_neq this) _,
        apply congr_arg finord.fs,
        exact h_ind (list.nodup_tail hnodup) n
      }
    }
  end

end

--- For a list `l` with `l.nodup`, the index access yields a bijection between the members of `l` and the standard finite set of cardinality `l.length`.
definition enum_bijection {α : Type _} [decidable_eq α] {l : list α} (h : l.nodup): bijection (finord l.length) {x // x ∈ l} :=
{
  to_fun := l.subenumerator,
  inv := l.indexer,
  left_inverse := list.indexer_left_inverse_of_subenumerator h,
  right_inverse := list.subenumerator_left_inverse_of_indexer
}

end list


inductive Weekday where
  | sunday    : Weekday
  | monday    : Weekday
  | tuesday   : Weekday
  | wednesday : Weekday
  | thursday  : Weekday
  | friday    : Weekday
  | saturday  : Weekday

def Weekday.next : Weekday -> Weekday :=
  fun d => match d with
    | sunday    => monday
    | monday    => tuesday
    | tuesday   => wednesday
    | wednesday => thursday
    | thursday  => friday
    | friday    => saturday
    | saturday  => sunday

def Weekday.previous : Weekday -> Weekday
  | sunday    => saturday
  | monday    => sunday
  | tuesday   => monday
  | wednesday => tuesday
  | thursday  => wednesday
  | friday    => thursday
  | saturday  => friday

theorem Weekday.nextOfPrevious (d : Weekday) : next (previous d) = d := by
  cases d
  allGoals rfl

theorem Weekday.nextOfPrevious' (d : Weekday) : previous (next d) = d ∧ next (previous d) = d := by
  apply And.intro
  cases d <;> rfl
  cases d <;> rfl

theorem Weekday.nextOfPrevious'' (d : Weekday) : previous (next d) = d ∧ next (previous d) = d := by
  apply And.intro <;> cases d <;> rfl

open Lean.Parser.Tactic in
macro "rwd " x:term : tactic => `(rw [$x:term]; done)

theorem ex (a b c : α) (h₁ : a = b) (h₂ : a = c) : b = a ∧ c = a := by
  apply And.intro <;> first | rwd h₁ | rwd h₂

theorem idEq (a : α) : id a = a :=
  rfl

theorem Weekday.test (d : Weekday) : next (previous d) = id d := by
  cases d
  traceState
  allGoals rw [idEq]
  traceState
  allGoals rfl

theorem Weekday.test2 (d : Weekday) : next (previous d) = id d := by
  cases d <;> rw [idEq]
  traceState
  allGoals rfl

def bug {a b c : Nat} (h₁ : a = b) (h₂ : b = c) : a = c := by
  apply Eq.trans <;> assumption


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.star.basic
import algebra.ring.prod
import algebra.module.prod

/-!
# `star` on product types

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

We put a `has_star` structure on product types that operates elementwise.
-/

universes u v w
variables {R : Type u} {S : Type v}

namespace prod

instance [has_star R] [has_star S] : has_star (R × S) :=
{ star := λ x, (star x.1, star x.2) }

@[simp] lemma fst_star [has_star R] [has_star S] (x : R × S) : (star x).1 = star x.1 := rfl
@[simp]

lemma star_def [has_star R] [has_star S] (x : R × S) : star x = (star x.1, star x.2) := rfl

instance [has_star R] [has_star S] [has_trivial_star R] [has_trivial_star S] :
  has_trivial_star (R × S) :=
{ star_trivial := λ _, prod.ext (star_trivial _) (star_trivial _) }

instance [has_involutive_star R] [has_involutive_star S] : has_involutive_star (R × S) :=
{ star_involutive := λ _, prod.ext (star_star _) (star_star _) }

instance [semigroup R] [semigroup S] [star_semigroup R] [star_semigroup S] :
  star_semigroup (R × S) :=
{ star_mul := λ _ _, prod.ext (star_mul _ _) (star_mul _ _) }

instance [add_monoid R] [add_monoid S] [star_add_monoid R] [star_add_monoid S] :
  star_add_monoid (R × S) :=
{ star_add := λ _ _, prod.ext (star_add _ _) (star_add _ _) }

instance [non_unital_semiring R] [non_unital_semiring S] [star_ring R] [star_ring S] :
  star_ring (R × S) :=
{ ..prod.star_add_monoid, ..(prod.star_semigroup : star_semigroup (R × S)) }

instance {α : Type w} [has_smul α R] [has_smul α S] [has_star α] [has_star R] [has_star S]
  [star_module α R] [star_module α S] :
  star_module α (R × S) :=
{ star_smul := λ r x, prod.ext (star_smul _ _) (star_smul _ _) }

end prod

@[simp] lemma units.embed_product_star [monoid R] [star_semigroup R] (u : Rˣ) :
  units.embed_product R (star u) = star (units.embed_product R u) := rfl


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import algebra.group_with_zero.power
import algebra.ring.equiv
import tactic.linarith

/-!
# Integer power operation on fields and division rings

This file collects basic facts about the operation of raising an element of a `division_ring` to an
integer power. More specialised results are provided in the case of a linearly ordered field.
-/

universe u

@[simp] lemma ring_hom.map_zpow {K L : Type*} [division_ring K] [division_ring L] (f : K →+* L) :
  ∀ (a : K) (n : ℤ), f (a ^ n) = f a ^ n :=
f.to_monoid_with_zero_hom.map_zpow

@[simp] lemma ring_equiv.map_zpow {K L : Type*} [division_ring K] [division_ring L] (f : K ≃+* L) :
  ∀ (a : K) (n : ℤ), f (a ^ n) = f a ^ n :=
f.to_ring_hom.map_zpow

@[simp] lemma zpow_bit0_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) :
  (-x) ^ (bit0 n) = x ^ bit0 n :=
by rw [zpow_bit0', zpow_bit0', neg_mul_neg]

@[simp] lemma zpow_bit1_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) :
  (-x) ^ (bit1 n) = - x ^ bit1 n :=
by rw [zpow_bit1', zpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg]

section ordered_field_power
open int

variables {K : Type u} [linear_ordered_field K] {a : K} {n : ℤ}

lemma zpow_nonneg {a : K} (ha : 0 ≤ a) : ∀ (z : ℤ), 0 ≤ a ^ z
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_nonneg ha _ }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_nonneg.2 (pow_nonneg ha _) }

lemma zpow_pos_of_pos {a : K} (ha : 0 < a) : ∀ (z : ℤ), 0 < a ^ z
| (n : ℕ) := by { rw zpow_coe_nat, exact pow_pos ha _ }
| -[1+n]  := by { rw zpow_neg_succ_of_nat, exact inv_pos.2 (pow_pos ha _) }

lemma zpow_le_of_le {x : K} (hx : 1 ≤ x) {a b : ℤ} (h : a ≤ b) : x ^ a ≤ x ^ b :=
begin
  induction a with a a; induction b with b b,
  { simp only [of_nat_eq_coe, zpow_coe_nat],
    apply pow_le_pow hx,
    apply le_of_coe_nat_le_coe_nat h },
  { apply absurd h,
    apply not_le_of_gt,
    exact lt_of_lt_of_le (neg_succ_lt_zero _) (of_nat_nonneg _) },
  { simp only [zpow_neg_succ_of_nat, one_div, of_nat_eq_coe, zpow_coe_nat],
    apply le_trans (inv_le_one _); apply one_le_pow_of_one_le hx },
  { simp only [zpow_neg_succ_of_nat],
    apply (inv_le_inv _ _).2,
    { apply pow_le_pow hx,
      have : -(↑(a+1) : ℤ) ≤ -(↑(b+1) : ℤ), from h,
      have h' := le_of_neg_le_neg this,
      apply le_of_coe_nat_le_coe_nat h' },
    repeat { apply pow_pos (lt_of_lt_of_le zero_lt_one hx) } }
end

lemma pow_le_max_of_min_le {x : K} (hx : 1 ≤ x) {a b c : ℤ} (h : min a b ≤ c) :
      x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) :=
begin
  wlog hle : a ≤ b,
  have hnle : -b ≤ -a, from neg_le_neg hle,
  have hfle : x ^ (-b) ≤ x ^ (-a), from zpow_le_of_le hx hnle,
  have : x ^ (-c) ≤ x ^ (-a),
  { apply zpow_le_of_le hx,
    simpa only [min_eq_left hle, neg_le_neg_iff] using h },
  simpa only [max_eq_left hfle]
end

lemma zpow_le_one_of_nonpos {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : z ≤ 0) : p ^ z ≤ 1 :=
calc p ^ z ≤ p ^ 0 : zpow_le_of_le hp hz
          ... = 1        : by simp

lemma one_le_zpow_of_nonneg {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : 0 ≤ z) : 1 ≤ p ^ z :=
calc p ^ z ≥ p ^ 0 : zpow_le_of_le hp hz
          ... = 1        : by simp

theorem zpow_bit0_nonneg (a : K) (n : ℤ) : 0 ≤ a ^ bit0 n :=
by { rw zpow_bit0₀, exact mul_self_nonneg _ }

theorem zpow_two_nonneg (a : K) : 0 ≤ a ^ (2 : ℤ) :=
zpow_bit0_nonneg a 1

theorem zpow_bit0_pos {a : K} (h : a ≠ 0) (n : ℤ) : 0 < a ^ bit0 n :=
(zpow_bit0_nonneg a n).lt_of_ne (zpow_ne_zero _ h).symm

theorem zpow_two_pos_of_ne_zero (a : K) (h : a ≠ 0) : 0 < a ^ (2 : ℤ) :=
zpow_bit0_pos h 1

@[simp] theorem zpow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 :=
⟨λ h, not_le.1 $ λ h', not_le.2 h $ zpow_nonneg h' _,
 λ h, by rw [bit1, zpow_add_one₀ h.ne]; exact mul_neg_of_pos_of_neg (zpow_bit0_pos h.ne _) h⟩

@[simp] theorem zpow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a :=
le_iff_le_iff_lt_iff_lt.2 zpow_bit1_neg_iff

@[simp] theorem zpow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 :=
begin
  rw [le_iff_lt_or_eq, zpow_bit1_neg_iff],
  split,
  { rintro (h | h),
    { exact h.le },
    { exact (zpow_eq_zero h).le } },
  { intro h,
    rcases eq_or_lt_of_le h with rfl|h,
    { exact or.inr (zero_zpow _ (bit1_ne_zero n)) },
    { exact or.inl h } }
end

@[simp] theorem zpow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a :=
lt_iff_lt_of_le_iff_le zpow_bit1_nonpos_iff

end ordered_field_power

lemma one_lt_zpow {K} [linear_ordered_field K] {p : K} (hp : 1 < p) :
  ∀ z : ℤ, 0 < z → 1 < p ^ z
| (n : ℕ) h := (zpow_coe_nat p n).symm.subst (one_lt_pow hp $ int.coe_nat_ne_zero.mp h.ne')
| -[1+ n] h := ((int.neg_succ_not_pos _).mp h).elim

section ordered
variables  {K : Type*} [linear_ordered_field K]

lemma nat.zpow_pos_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : 0 < (p:K)^n :=
by { apply zpow_pos_of_pos, exact_mod_cast h }

lemma nat.zpow_ne_zero_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : (p:K)^n ≠ 0 :=
ne_of_gt (nat.zpow_pos_of_pos h n)

lemma zpow_strict_mono {x : K} (hx : 1 < x) :
  strict_mono (λ n:ℤ, x ^ n) :=
strict_mono_int_of_lt_succ $ λ n,
have xpos : 0 < x, from zero_lt_one.trans hx,
calc x ^ n < x ^ n * x : lt_mul_of_one_lt_right (zpow_pos_of_pos xpos _) hx
... = x ^ (n + 1) : (zpow_add_one₀ xpos.ne' _).symm

lemma zpow_strict_anti {x : K} (h₀ : 0 < x) (h₁ : x < 1) : strict_anti (λ n : ℤ, x ^ n) :=
strict_anti_int_of_succ_lt $ λ n,
calc x ^ (n + 1) = x ^ n * x : zpow_add_one₀ h₀.ne' _
... < x ^ n * 1 : (mul_lt_mul_left $ zpow_pos_of_pos h₀ _).2 h₁
... = x ^ n : mul_one _

@[simp] lemma zpow_lt_iff_lt {x : K} (hx : 1 < x) {m n : ℤ} :
  x ^ m < x ^ n ↔ m < n :=
(zpow_strict_mono hx).lt_iff_lt

@[simp] lemma zpow_le_iff_le {x : K} (hx : 1 < x) {m n : ℤ} :
  x ^ m ≤ x ^ n ↔ m ≤ n :=
(zpow_strict_mono hx).le_iff_le

lemma min_le_of_zpow_le_max {x : K} (hx : 1 < x) {a b c : ℤ}
  (h_max : x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) ) : min a b ≤ c :=
begin
  rw min_le_iff,
  refine or.imp (λ h, _) (λ h, _) (le_max_iff.mp h_max);
  rwa [zpow_le_iff_le hx, neg_le_neg_iff] at h
end

@[simp] lemma pos_div_pow_pos {a b : K} (ha : 0 < a) (hb : 0 < b) (k : ℕ) : 0 < a/b^k :=
div_pos ha (pow_pos hb k)

@[simp] lemma div_pow_le {a b : K} (ha : 0 < a) (hb : 1 ≤ b) (k : ℕ) : a/b^k ≤ a :=
(div_le_iff $ pow_pos (lt_of_lt_of_le zero_lt_one hb) k).mpr
(calc a = a * 1 : (mul_one a).symm
   ...  ≤ a*b^k : (mul_le_mul_left ha).mpr $ one_le_pow_of_one_le hb _)

lemma zpow_injective {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) :
  function.injective ((^) x : ℤ → K) :=
begin
  intros m n h,
  rcases h₁.lt_or_lt with H|H,
  { apply (zpow_strict_mono (one_lt_inv h₀ H)).injective,
    show x⁻¹ ^ m = x⁻¹ ^ n,
    rw [← zpow_neg_one, ← zpow_mul₀, ← zpow_mul₀, mul_comm _ m, mul_comm _ n, zpow_mul₀, zpow_mul₀,
      h], },
  { exact (zpow_strict_mono H).injective h, },
end

@[simp] lemma zpow_inj {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) {m n : ℤ} :
  x ^ m = x ^ n ↔ m = n :=
(zpow_injective h₀ h₁).eq_iff

end ordered

section
variables {K : Type*} [division_ring K]

@[simp, norm_cast] theorem rat.cast_zpow [char_zero K] (q : ℚ) (n : ℤ) :
  ((q ^ n : ℚ) : K) = q ^ n :=
(rat.cast_hom K).map_zpow q n

end


import tactic

--BEGIN--

/--------------------------------------------------------------------------

``cases``

  ``cases`` is a general tactic that breaks up complicated terms.
  If ``hpq`` is a term of type ``P ∧ Q`` or ``P ∨ Q`` or ``P ↔ Q``, then use
  ``cases hpq with hp hq,``.

``split``

  If the target of the current goal is ``P ∧ Q`` or ``P ↔ Q``, then use
  ``split,``.

``left``/``right``

  If the target of the current goal is ``P ∨ Q``, then use
  either ``left,`` or ``right,`` (choose wisely).

Delete the ``sorry,`` below and replace them with a legitimate proof.

--------------------------------------------------------------------------/

theorem bracket_example (P Q : Prop) (hp : P) (hq : Q) : P ∧ Q :=
begin
  split,
  {
    sorry,
  },
  {
    sorry,
  }
end

example (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
  sorry,
end

example (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
  sorry,
end

--END--


def f1 (x : Nat) : Nat :=
  let rec g (x : Nat) := x + 1 -- f1.g already declared
  let rec g (x : Nat) := x + 2
  g x

def f2 (x : Nat) : Nat :=
  let g1 (x : Nat) :=
    let rec h (x : Nat) := x + 1
    h x
  let g2 (x : Nat) :=
    let rec h (x : Nat) := x + 2 -- error f.h already declared
    h x
  g1 x + g2 x

def f3.h := 10

def f3 (x : Nat) : Nat :=
  let rec h (x : Nat) := x + 2 -- error f3.h already declared
  h x

def f4 (x : Nat) : Nat :=
  let rec g1 (x : Nat) :=
    let rec h (x : Nat) := x + 1  -- this is f4.g1.h
    h x
  let rec g2 (x : Nat) :=
    let rec h (x : Nat) := x + 2  -- this is f4.g2.h
    h x
  g1 x + g2 x

theorem ex1 (x : Nat) : f4 x = (x + 1) + (x + 2) :=
  rfl

theorem ex2 (x : Nat) : f4.g1.h x = x + 1 :=
  rfl

theorem ex3 (x : Nat) : f4.g2.h x = x + 2 :=
  rfl


/-
Copyright (c) 2020 Kyle Miller All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller

! This file was ported from Lean 3 source module data.sym.basic
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Multiset.Basic
import Mathlib.Data.Vector.Basic
import Mathlib.Data.Setoid.Basic
import Mathlib.Tactic.ApplyFun
import Mathlib.Tactic.Lift

/-!
# Symmetric powers

This file defines symmetric powers of a type.  The nth symmetric power
consists of homogeneous n-tuples modulo permutations by the symmetric
group.

The special case of 2-tuples is called the symmetric square, which is
addressed in more detail in `Data.Sym.Sym2`.

TODO: This was created as supporting material for `Sym2`; it
needs a fleshed-out interface.

## Tags

symmetric powers

-/

open Function

/-- The nth symmetric power is n-tuples up to permutation.  We define it
as a subtype of `Multiset` since these are well developed in the
library.  We also give a definition `Sym.sym'` in terms of vectors, and we
show these are equivalent in `Sym.symEquivSym'`.
-/
def Sym (α : Type _) (n : ℕ) :=
  { s : Multiset α // Multiset.card s = n }
#align sym Sym

--Porting note: new definition
/-- The canoncial map to `Multiset α` that forgets that `s` has length `n` -/
@[coe] def Sym.toMultiset {α : Type _} {n : ℕ} (s : Sym α n) : Multiset α :=
  s.1

instance Sym.hasCoe (α : Type _) (n : ℕ) : CoeOut (Sym α n) (Multiset α) :=
  ⟨Sym.toMultiset⟩
#align sym.has_coe Sym.hasCoe

-- Porting note: instance needed for Data.Finset.Sym
instance [DecidableEq α]: DecidableEq (Sym α n) := Subtype.instDecidableEqSubtype

/-- This is the `List.Perm` setoid lifted to `Vector`.

See note [reducible non-instances].
-/
@[reducible]
def Vector.Perm.isSetoid (α : Type _) (n : ℕ) : Setoid (Vector α n) :=
  (List.isSetoid α).comap Subtype.val
#align vector.perm.is_setoid Vector.Perm.isSetoid

attribute [local instance] Vector.Perm.isSetoid

namespace Sym

variable {α β : Type _} {n n' m : ℕ} {s : Sym α n} {a b : α}

theorem coe_injective : Injective ((↑) : Sym α n → Multiset α) :=
  Subtype.coe_injective
#align sym.coe_injective Sym.coe_injective

@[simp, norm_cast]
theorem coe_inj {s₁ s₂ : Sym α n} : (s₁ : Multiset α) = s₂ ↔ s₁ = s₂ :=
  coe_injective.eq_iff
#align sym.coe_inj Sym.coe_inj

--Porting note: new theorem
@[ext] theorem ext {s₁ s₂ : Sym α n} (h : (s₁ : Multiset α) = ↑s₂) : s₁ = s₂ :=
  coe_injective h

--Porting note: new theorem
@[simp]
theorem val_eq_coe (s : Sym α n) : s.1 = ↑s :=
  rfl

/-- Construct an element of the `n`th symmetric power from a multiset of cardinality `n`.
-/
@[match_pattern] --Porting note: removed `@[simps]`, generated bad lemma
abbrev mk (m : Multiset α) (h : Multiset.card m = n) : Sym α n :=
  ⟨m, h⟩
#align sym.mk Sym.mk

/-- The unique element in `Sym α 0`. -/
@[match_pattern]
def nil : Sym α 0 :=
  ⟨0, Multiset.card_zero⟩
#align sym.nil Sym.nil

@[simp]

/-- Inserts an element into the term of `sym α n`, increasing the length by one.
-/
@[match_pattern]
def cons (a : α) (s : Sym α n) : Sym α n.succ :=
  ⟨a ::ₘ s.1, by rw [Multiset.card_cons, s.2]⟩
#align sym.cons Sym.cons

@[inherit_doc]
infixr:67 " ::ₛ " => cons

@[simp]
theorem cons_inj_right (a : α) (s s' : Sym α n) : a ::ₛ s = a ::ₛ s' ↔ s = s' :=
  Subtype.ext_iff.trans <| (Multiset.cons_inj_right _).trans Subtype.ext_iff.symm
#align sym.cons_inj_right Sym.cons_inj_right

@[simp]
theorem cons_inj_left (a a' : α) (s : Sym α n) : a ::ₛ s = a' ::ₛ s ↔ a = a' :=
  Subtype.ext_iff.trans <| Multiset.cons_inj_left _
#align sym.cons_inj_left Sym.cons_inj_left

theorem cons_swap (a b : α) (s : Sym α n) : a ::ₛ b ::ₛ s = b ::ₛ a ::ₛ s :=
  Subtype.ext <| Multiset.cons_swap a b s.1
#align sym.cons_swap Sym.cons_swap

theorem coe_cons (s : Sym α n) (a : α) : (a ::ₛ s : Multiset α) = a ::ₘ s :=
  rfl
#align sym.coe_cons Sym.coe_cons

/-- This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
def ofVector : Vector α n → Sym α n :=
  fun x => ⟨↑x.val, (Multiset.coe_card _).trans x.2⟩

/-- This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
instance : Coe (Vector α n) (Sym α n) where coe x := ofVector x

@[simp]
theorem of_vector_nil : ↑(Vector.nil : Vector α 0) = (Sym.nil : Sym α 0) :=
  rfl
#align sym.of_vector_nil Sym.of_vector_nil

@[simp]
theorem of_vector_cons (a : α) (v : Vector α n) : ↑(Vector.cons a v) = a ::ₛ (↑v : Sym α n) :=
  by
  cases v
  rfl
#align sym.of_vector_cons Sym.of_vector_cons

/-- `α ∈ s` means that `a` appears as one of the factors in `s`.
-/
instance : Membership α (Sym α n) :=
  ⟨fun a s => a ∈ s.1⟩

instance decidableMem [DecidableEq α] (a : α) (s : Sym α n) : Decidable (a ∈ s) :=
  s.1.decidableMem _
#align sym.decidable_mem Sym.decidableMem

@[simp]
theorem mem_mk (a : α) (s : Multiset α) (h : Multiset.card s = n) : a ∈ mk s h ↔ a ∈ s :=
  Iff.rfl
#align sym.mem_mk Sym.mem_mk

@[simp]
theorem mem_cons : a ∈ b ::ₛ s ↔ a = b ∨ a ∈ s :=
  Multiset.mem_cons
#align sym.mem_cons Sym.mem_cons

@[simp]
theorem mem_coe : a ∈ (s : Multiset α) ↔ a ∈ s :=
  Iff.rfl
#align sym.mem_coe Sym.mem_coe

theorem mem_cons_of_mem (h : a ∈ s) : a ∈ b ::ₛ s :=
  Multiset.mem_cons_of_mem h
#align sym.mem_cons_of_mem Sym.mem_cons_of_mem

--@[simp] Porting note: simp can prove it
theorem mem_cons_self (a : α) (s : Sym α n) : a ∈ a ::ₛ s :=
  Multiset.mem_cons_self a s.1
#align sym.mem_cons_self Sym.mem_cons_self

theorem cons_of_coe_eq (a : α) (v : Vector α n) : a ::ₛ (↑v : Sym α n) = ↑(a ::ᵥ v) :=
  Subtype.ext <| by
    cases v
    rfl
#align sym.cons_of_coe_eq Sym.cons_of_coe_eq

theorem sound {a b : Vector α n} (h : a.val ~ b.val) : (↑a : Sym α n) = ↑b :=
  Subtype.ext <| Quotient.sound h
#align sym.sound Sym.sound

/-- `erase s a h` is the sym that subtracts 1 from the
  multiplicity of `a` if a is present in the sym. -/
def erase [DecidableEq α] (s : Sym α (n + 1)) (a : α) (h : a ∈ s) : Sym α n :=
  ⟨s.val.erase a, (Multiset.card_erase_of_mem h).trans <| s.property.symm ▸ n.pred_succ⟩
#align sym.erase Sym.erase

@[simp]
theorem erase_mk [DecidableEq α] (m : Multiset α)
    (hc : Multiset.card m = n + 1) (a : α) (h : a ∈ m) :
    (mk m hc).erase a h =mk (m.erase a)
        (by rw [Multiset.card_erase_of_mem h, hc]; rfl) :=
  rfl
#align sym.erase_mk Sym.erase_mk

@[simp]
theorem coe_erase [DecidableEq α] {s : Sym α n.succ} {a : α} (h : a ∈ s) :
    (s.erase a h : Multiset α) = Multiset.erase s a :=
  rfl
#align sym.coe_erase Sym.coe_erase

@[simp]
theorem cons_erase [DecidableEq α] {s : Sym α n.succ} {a : α} (h : a ∈ s) : a ::ₛ s.erase a h = s :=
  coe_injective <| Multiset.cons_erase h
#align sym.cons_erase Sym.cons_erase

@[simp]
theorem erase_cons_head [DecidableEq α] (s : Sym α n) (a : α)
    (h : a ∈ a ::ₛ s := mem_cons_self a s) : (a ::ₛ s).erase a h = s :=
  coe_injective <| Multiset.erase_cons_head a s.1
#align sym.erase_cons_head Sym.erase_cons_head

/-- Another definition of the nth symmetric power, using vectors modulo permutations. (See `Sym`.)
-/
def Sym' (α : Type _) (n : ℕ) :=
  Quotient (Vector.Perm.isSetoid α n)
#align sym.sym' Sym.Sym'

/-- This is `cons` but for the alternative `Sym'` definition.
-/
def cons' {α : Type _} {n : ℕ} : α → Sym' α n → Sym' α (Nat.succ n) := fun a =>
  Quotient.map (Vector.cons a) fun ⟨_, _⟩ ⟨_, _⟩ h => List.Perm.cons _ h
#align sym.cons' Sym.cons'

@[inherit_doc]
scoped notation a " :: " b => cons' a b

/-- Multisets of cardinality n are equivalent to length-n vectors up to permutations.
-/
def symEquivSym' {α : Type _} {n : ℕ} : Sym α n ≃ Sym' α n :=
  Equiv.subtypeQuotientEquivQuotientSubtype _ _ (fun _ => by rfl) fun _ _ => by rfl
#align sym.sym_equiv_sym' Sym.symEquivSym'

theorem cons_equiv_eq_equiv_cons (α : Type _) (n : ℕ) (a : α) (s : Sym α n) :
    (a::symEquivSym' s) = symEquivSym' (a ::ₛ s) :=
  by
  rcases s with ⟨⟨l⟩, _⟩
  rfl
#align sym.cons_equiv_eq_equiv_cons Sym.cons_equiv_eq_equiv_cons

instance : Zero (Sym α 0) :=
  ⟨⟨0, rfl⟩⟩

instance : EmptyCollection (Sym α 0) :=
  ⟨0⟩

theorem eq_nil_of_card_zero (s : Sym α 0) : s = nil :=
  Subtype.ext <| Multiset.card_eq_zero.1 s.2
#align sym.eq_nil_of_card_zero Sym.eq_nil_of_card_zero

instance uniqueZero : Unique (Sym α 0) :=
  ⟨⟨nil⟩, eq_nil_of_card_zero⟩
#align sym.unique_zero Sym.uniqueZero

/-- `replicate n a` is the sym containing only `a` with multiplicity `n`. -/
def replicate (n : ℕ) (a : α) : Sym α n :=
  ⟨Multiset.replicate n a, Multiset.card_replicate _ _⟩
#align sym.replicate Sym.replicate

theorem replicate_succ {a : α} {n : ℕ} : replicate n.succ a = a ::ₛ replicate n a :=
  rfl
#align sym.replicate_succ Sym.replicate_succ

theorem coe_replicate : (replicate n a : Multiset α) = Multiset.replicate n a :=
  rfl
#align sym.coe_replicate Sym.coe_replicate

@[simp]
theorem mem_replicate : b ∈ replicate n a ↔ n ≠ 0 ∧ b = a :=
  Multiset.mem_replicate
#align sym.mem_replicate Sym.mem_replicate

theorem eq_replicate_iff : s = replicate n a ↔ ∀ b ∈ s, b = a := by
  erw [Subtype.ext_iff, Multiset.eq_replicate]
  exact and_iff_right s.2
#align sym.eq_replicate_iff Sym.eq_replicate_iff

theorem exists_mem (s : Sym α n.succ) : ∃ a, a ∈ s :=
  Multiset.card_pos_iff_exists_mem.1 <| s.2.symm ▸ n.succ_pos
#align sym.exists_mem Sym.exists_mem

theorem exists_eq_cons_of_succ (s : Sym α n.succ) : ∃ (a : α)(s' : Sym α n), s = a ::ₛ s' :=
  by
  obtain ⟨a, ha⟩ := exists_mem s
  classical exact ⟨a, s.erase a ha, (cons_erase ha).symm⟩
#align sym.exists_eq_cons_of_succ Sym.exists_eq_cons_of_succ

theorem eq_replicate {a : α} {n : ℕ} {s : Sym α n} : s = replicate n a ↔ ∀ b ∈ s, b = a :=
  Subtype.ext_iff.trans <| Multiset.eq_replicate.trans <| and_iff_right s.prop
#align sym.eq_replicate Sym.eq_replicate

theorem eq_replicate_of_subsingleton [Subsingleton α] (a : α) {n : ℕ} (s : Sym α n) :
    s = replicate n a :=
  eq_replicate.2 fun _ _ => Subsingleton.elim _ _
#align sym.eq_replicate_of_subsingleton Sym.eq_replicate_of_subsingleton

instance [Subsingleton α] (n : ℕ) : Subsingleton (Sym α n) :=
  ⟨by
    cases n
    · simp
    · intro s s'
      obtain ⟨b, -⟩ := exists_mem s
      rw [eq_replicate_of_subsingleton b s', eq_replicate_of_subsingleton b s]⟩

instance inhabitedSym [Inhabited α] (n : ℕ) : Inhabited (Sym α n) :=
  ⟨replicate n default⟩
#align sym.inhabited_sym Sym.inhabitedSym

instance inhabitedSym' [Inhabited α] (n : ℕ) : Inhabited (Sym' α n) :=
  ⟨Quotient.mk' (Vector.replicate n default)⟩
#align sym.inhabited_sym' Sym.inhabitedSym'

instance (n : ℕ) [IsEmpty α] : IsEmpty (Sym α n.succ) :=
  ⟨fun s => by
    obtain ⟨a, -⟩ := exists_mem s
    exact isEmptyElim a⟩

instance (n : ℕ) [Unique α] : Unique (Sym α n) :=
  Unique.mk' _

theorem replicate_right_inj {a b : α} {n : ℕ} (h : n ≠ 0) : replicate n a = replicate n b ↔ a = b :=
  Subtype.ext_iff.trans (Multiset.replicate_right_inj h)
#align sym.replicate_right_inj Sym.replicate_right_inj

theorem replicate_right_injective {n : ℕ} (h : n ≠ 0) :
    Function.Injective (replicate n : α → Sym α n) := fun _ _ => (replicate_right_inj h).1
#align sym.replicate_right_injective Sym.replicate_right_injective

instance (n : ℕ) [Nontrivial α] : Nontrivial (Sym α (n + 1)) :=
  (replicate_right_injective n.succ_ne_zero).nontrivial

/-- A function `α → β` induces a function `sym α n → sym β n` by applying it to every element of
the underlying `n`-tuple. -/
def map {n : ℕ} (f : α → β) (x : Sym α n) : Sym β n :=
  ⟨x.val.map f, by simpa [Multiset.card_map] using x.property⟩
#align sym.map Sym.map

@[simp]
theorem mem_map {n : ℕ} {f : α → β} {b : β} {l : Sym α n} :
    b ∈ Sym.map f l ↔ ∃ a, a ∈ l ∧ f a = b :=
  Multiset.mem_map
#align sym.mem_map Sym.mem_map

/-- Note: `sym.map_id` is not simp-normal, as simp ends up unfolding `id` with `sym.map_congr` -/
@[simp]
theorem map_id' {α : Type _} {n : ℕ} (s : Sym α n) : Sym.map (fun x : α => x) s = s := by
  ext; simp [Sym.map]; rfl
#align sym.map_id' Sym.map_id'

theorem map_id {α : Type _} {n : ℕ} (s : Sym α n) : Sym.map id s = s := by
  ext; simp [Sym.map]; rfl
#align sym.map_id Sym.map_id

@[simp]
theorem map_map {α β γ : Type _} {n : ℕ} (g : β → γ) (f : α → β) (s : Sym α n) :
    Sym.map g (Sym.map f s) = Sym.map (g ∘ f) s :=
  Subtype.ext <| by dsimp only [Sym.map]; simp
#align sym.map_map Sym.map_map

@[simp]
theorem map_zero (f : α → β) : Sym.map f (0 : Sym α 0) = (0 : Sym β 0) :=
  rfl
#align sym.map_zero Sym.map_zero

@[simp]
theorem map_cons {n : ℕ} (f : α → β) (a : α) (s : Sym α n) : (a ::ₛ s).map f = f a ::ₛ s.map f :=
  ext <| Multiset.map_cons _ _ _
#align sym.map_cons Sym.map_cons

@[congr]
theorem map_congr {f g : α → β} {s : Sym α n} (h : ∀ x ∈ s, f x = g x) : map f s = map g s :=
  Subtype.ext <| Multiset.map_congr rfl h
#align sym.map_congr Sym.map_congr

@[simp]
theorem map_mk {f : α → β} {m : Multiset α} {hc : Multiset.card m = n} :
    map f (mk m hc) = mk (m.map f) (by simp [hc]) :=
  rfl
#align sym.map_mk Sym.map_mk

@[simp]
theorem coe_map (s : Sym α n) (f : α → β) : ↑(s.map f) = Multiset.map f s :=
  rfl
#align sym.coe_map Sym.coe_map

theorem map_injective {f : α → β} (hf : Injective f) (n : ℕ) :
    Injective (map f : Sym α n → Sym β n) := fun _ _ h =>
  coe_injective <| Multiset.map_injective hf <| coe_inj.2 h
#align sym.map_injective Sym.map_injective

/-- Mapping an equivalence `α ≃ β` using `Sym.map` gives an equivalence between `Sym α n` and
`Sym β n`. -/
@[simps]
def equivCongr (e : α ≃ β) : Sym α n ≃ Sym β n
    where
  toFun := map e
  invFun := map e.symm
  left_inv x := by rw [map_map, Equiv.symm_comp_self, map_id]
  right_inv x := by rw [map_map, Equiv.self_comp_symm, map_id]
#align sym.equiv_congr Sym.equivCongr
#align sym.equiv_congr_symm_apply Sym.equivCongr_symm_apply
#align sym.equiv_congr_apply Sym.equivCongr_apply

/-- "Attach" a proof that `a ∈ s` to each element `a` in `s` to produce
an element of the symmetric power on `{x // x ∈ s}`. -/
def attach (s : Sym α n) : Sym { x // x ∈ s } n :=
  ⟨s.val.attach, by conv_rhs => rw [← s.2, ← Multiset.card_attach]⟩
#align sym.attach Sym.attach

@[simp]
theorem attach_mk {m : Multiset α} {hc : Multiset.card m = n} :
    attach (mk m hc) = mk m.attach (Multiset.card_attach.trans hc) :=
  rfl
#align sym.attach_mk Sym.attach_mk

@[simp]
theorem coe_attach (s : Sym α n) : (s.attach : Multiset { a // a ∈ s }) =
    Multiset.attach (s : Multiset α) :=
  rfl
#align sym.coe_attach Sym.coe_attach

theorem attach_map_coe (s : Sym α n) : s.attach.map (↑) = s :=
  coe_injective <| Multiset.attach_map_val _
#align sym.attach_map_coe Sym.attach_map_coe

@[simp]
theorem mem_attach (s : Sym α n) (x : { x // x ∈ s }) : x ∈ s.attach :=
  Multiset.mem_attach _ _
#align sym.mem_attach Sym.mem_attach

@[simp]
theorem attach_nil : (nil : Sym α 0).attach = nil :=
  rfl
#align sym.attach_nil Sym.attach_nil

@[simp]
theorem attach_cons (x : α) (s : Sym α n) :
    (cons x s).attach =
      cons ⟨x, mem_cons_self _ _⟩ (s.attach.map fun x => ⟨x, mem_cons_of_mem x.prop⟩) :=
  coe_injective <| Multiset.attach_cons _ _
#align sym.attach_cons Sym.attach_cons

/-- Change the length of a `Sym` using an equality.
The simp-normal form is for the `cast` to be pushed outward. -/
protected def cast {n m : ℕ} (h : n = m) : Sym α n ≃ Sym α m
    where
  toFun s := ⟨s.val, s.2.trans h⟩
  invFun s := ⟨s.val, s.2.trans h.symm⟩
  left_inv _ := Subtype.ext rfl
  right_inv _ := Subtype.ext rfl
#align sym.cast Sym.cast

@[simp]
theorem cast_rfl : Sym.cast rfl s = s :=
  Subtype.ext rfl
#align sym.cast_rfl Sym.cast_rfl

@[simp]
theorem cast_cast {n'' : ℕ} (h : n = n') (h' : n' = n'') :
    Sym.cast h' (Sym.cast h s) = Sym.cast (h.trans h') s :=
  rfl
#align sym.cast_cast Sym.cast_cast

@[simp]
theorem coe_cast (h : n = m) : (Sym.cast h s : Multiset α) = s :=
  rfl
#align sym.coe_cast Sym.coe_cast

@[simp]
theorem mem_cast (h : n = m) : a ∈ Sym.cast h s ↔ a ∈ s :=
  Iff.rfl
#align sym.mem_cast Sym.mem_cast

/-- Append a pair of `sym` terms. -/
def append (s : Sym α n) (s' : Sym α n') : Sym α (n + n') :=
  ⟨s.1 + s'.1, by rw [map_add, s.2, s'.2]⟩
#align sym.append Sym.append

@[simp]
theorem append_inj_right (s : Sym α n) {t t' : Sym α n'} : s.append t = s.append t' ↔ t = t' :=
  Subtype.ext_iff.trans <| (add_right_inj _).trans Subtype.ext_iff.symm
#align sym.append_inj_right Sym.append_inj_right

@[simp]
theorem append_inj_left {s s' : Sym α n} (t : Sym α n') : s.append t = s'.append t ↔ s = s' :=
  Subtype.ext_iff.trans <| (add_left_inj _).trans Subtype.ext_iff.symm
#align sym.append_inj_left Sym.append_inj_left

theorem append_comm (s : Sym α n') (s' : Sym α n') :
    s.append s' = Sym.cast (add_comm _ _) (s'.append s) := by
  ext
  simp [append, add_comm]
#align sym.append_comm Sym.append_comm

@[simp, norm_cast]
theorem coe_append (s : Sym α n) (s' : Sym α n') : (s.append s' : Multiset α) = s + s' :=
  rfl
#align sym.coe_append Sym.coe_append

theorem mem_append_iff {s' : Sym α m} : a ∈ s.append s' ↔ a ∈ s ∨ a ∈ s' :=
  Multiset.mem_add
#align sym.mem_append_iff Sym.mem_append_iff

/-- Fill a term `m : Sym α (n - i)` with `i` copies of `a` to obtain a term of `Sym α n`.
This is a convenience wrapper for `m.append (replicate i a)` that adjusts the term using
`Sym.cast`. -/
def fill (a : α) (i : Fin (n + 1)) (m : Sym α (n - i)) : Sym α n :=
  Sym.cast (Nat.sub_add_cancel i.is_le) (m.append (replicate i a))
#align sym.fill Sym.fill

theorem coe_fill {a : α} {i : Fin (n + 1)} {m : Sym α (n - i)} :
    (fill a i m : Multiset α) = m + replicate i a :=
  rfl
#align sym.coe_fill Sym.coe_fill

theorem mem_fill_iff {a b : α} {i : Fin (n + 1)} {s : Sym α (n - i)} :
    a ∈ Sym.fill b i s ↔ (i : ℕ) ≠ 0 ∧ a = b ∨ a ∈ s := by
  rw [fill, mem_cast, mem_append_iff, or_comm, mem_replicate]
#align sym.mem_fill_iff Sym.mem_fill_iff

open Multiset

/-- Remove every `a` from a given `Sym α n`.
Yields the number of copies `i` and a term of `Sym α (n - i)`. -/
def filterNe [DecidableEq α] (a : α) (m : Sym α n) : Σi : Fin (n + 1), Sym α (n - i) :=
  ⟨⟨m.1.count a, (count_le_card _ _).trans_lt <| by rw [m.2, Nat.lt_succ_iff]⟩,
    m.1.filter ((· ≠ ·) a),
    eq_tsub_of_add_eq <|
      Eq.trans
        (by
          rw [← countp_eq_card_filter, add_comm]
          simp only [eq_comm, Ne.def, count]
          rw [← card_eq_countp_add_countp _ _])
        m.2⟩
#align sym.filter_ne Sym.filterNe

theorem sigma_sub_ext {m₁ m₂ : Σi : Fin (n + 1), Sym α (n - i)} (h : (m₁.2 : Multiset α) = m₂.2) :
    m₁ = m₂ :=
  Sigma.subtype_ext
    (Fin.ext <| by
      rw [← Nat.sub_sub_self (Nat.le_of_lt_succ m₁.1.is_lt), ← m₁.2.2, val_eq_coe, h,
        ← val_eq_coe, m₂.2.2, Nat.sub_sub_self (Nat.le_of_lt_succ m₂.1.is_lt)])
    h
#align sym.sigma_sub_ext Sym.sigma_sub_ext

theorem fill_filterNe [DecidableEq α] (a : α) (m : Sym α n) :
    (m.filterNe a).2.fill a (m.filterNe a).1 = m :=
  Sym.ext
    (by
      rw [coe_fill, filterNe, ← val_eq_coe, Subtype.coe_mk, Fin.val_mk]
      ext b; dsimp
      rw [count_add, count_filter, Sym.coe_replicate, count_replicate]
      obtain rfl | h := eq_or_ne a b
      · rw [if_pos rfl, if_neg (not_not.2 rfl), zero_add]
      · rw [if_pos h, if_neg h.symm, add_zero])
#align sym.fill_filter_ne Sym.fill_filterNe

theorem filter_ne_fill [DecidableEq α] (a : α) (m : Σi : Fin (n + 1), Sym α (n - i)) (h : a ∉ m.2) :
    (m.2.fill a m.1).filterNe a = m :=
  sigma_sub_ext
    (by
      rw [filterNe, ← val_eq_coe, Subtype.coe_mk, val_eq_coe, coe_fill]
      rw [filter_add, filter_eq_self.2, add_right_eq_self, eq_zero_iff_forall_not_mem]
      · intro b hb
        rw [mem_filter, Sym.mem_coe, mem_replicate] at hb
        exact hb.2 hb.1.2.symm
      · exact fun a ha ha' => h <| ha'.symm ▸ ha)
#align sym.filter_ne_fill Sym.filter_ne_fill

end Sym

section Equiv

/-! ### Combinatorial equivalences -/

variable {α : Type _} {n : ℕ}

open Sym

namespace SymOptionSuccEquiv

/-- Function from the symmetric product over `Option` splitting on whether or not
it contains a `none`. -/
def encode [DecidableEq α] (s : Sym (Option α) n.succ) : Sum (Sym (Option α) n) (Sym α n.succ) :=
  if h : none ∈ s then Sum.inl (s.erase none h)
  else
    Sum.inr
      (s.attach.map fun o =>
        o.1.get <| Option.ne_none_iff_isSome.1 <| ne_of_mem_of_not_mem o.2 h)
#align sym_option_succ_equiv.encode SymOptionSuccEquiv.encode

@[simp]
theorem encode_of_none_mem [DecidableEq α] (s : Sym (Option α) n.succ) (h : none ∈ s) :
    encode s = Sum.inl (s.erase none h) :=
  dif_pos h
#align sym_option_succ_equiv.encode_of_none_mem SymOptionSuccEquiv.encode_of_none_mem

@[simp]
theorem encode_of_not_none_mem [DecidableEq α] (s : Sym (Option α) n.succ) (h : ¬none ∈ s) :
    encode s =
      Sum.inr
        (s.attach.map fun o =>
          o.1.get <| Option.ne_none_iff_isSome.1 <| ne_of_mem_of_not_mem o.2 h) :=
  dif_neg h
#align sym_option_succ_equiv.encode_of_not_none_mem SymOptionSuccEquiv.encode_of_not_none_mem

/-- Inverse of `Sym_option_succ_equiv.decode`. -/
-- @[simp] Porting note: not a nice simp lemma, applies too often in LEan4
def decode : Sum (Sym (Option α) n) (Sym α n.succ) → Sym (Option α) n.succ
  | Sum.inl s => none ::ₛ s
  | Sum.inr s => s.map Embedding.some
#align sym_option_succ_equiv.decode SymOptionSuccEquiv.decode

-- Porting note: new theorem
@[simp]
theorem decode_inl (s : Sym (Option α) n) : decode (Sum.inl s) = none ::ₛ s :=
  rfl

--Porting note: new theorem
@[simp]
theorem decode_inr (s : Sym α n.succ) : decode (Sum.inr s) = s.map Embedding.some :=
  rfl

@[simp]
theorem decode_encode [DecidableEq α] (s : Sym (Option α) n.succ) : decode (encode s) = s :=
  by
  by_cases h : none ∈ s
  · simp [h]
  · simp only [decode, h, not_false_iff, encode_of_not_none_mem, Embedding.some_apply, map_map,
      comp_apply, Option.some_get]
    convert s.attach_map_coe
#align sym_option_succ_equiv.decode_encode SymOptionSuccEquiv.decode_encode

@[simp]
theorem encode_decode [DecidableEq α] (s : Sum (Sym (Option α) n) (Sym α n.succ)) :
    encode (decode s) = s := by
  obtain s | s := s
  · simp
  · unfold SymOptionSuccEquiv.encode
    split_ifs with h
    · obtain ⟨a, _, ha⟩ := Multiset.mem_map.mp h
      exact Option.some_ne_none _ ha
    · refine' congr_arg Sum.inr _
      refine' map_injective (Option.some_injective _) _ _
      refine' Eq.trans _ (Eq.trans (SymOptionSuccEquiv.decode (Sum.inr s)).attach_map_coe _)
      simp; simp
#align sym_option_succ_equiv.encode_decode SymOptionSuccEquiv.encode_decode

end SymOptionSuccEquiv

/-- The symmetric product over `Option` is a disjoint union over simpler symmetric products. -/
--@[simps]
def symOptionSuccEquiv [DecidableEq α] :
    Sym (Option α) n.succ ≃ Sum (Sym (Option α) n) (Sym α n.succ)
    where
  toFun := SymOptionSuccEquiv.encode
  invFun := SymOptionSuccEquiv.decode
  left_inv := SymOptionSuccEquiv.decode_encode
  right_inv := SymOptionSuccEquiv.encode_decode
#align sym_option_succ_equiv symOptionSuccEquiv

end Equiv


import data.set.finite
import data.finset.image

def s : finset (fin 3) := {0, 1}

example : finset (fin 3) := s.map (equiv.add_left (1 : fin 3)).to_embedding
example : finset (fin 3) := s.map (equiv.add_left (1 : fin 3))

def f : equiv (fin 3) (fin 3) :=
{ to_fun := λ x, x + 1,
  inv_fun := λ x, x - 1,
  left_inv := dec_trivial,
  right_inv := dec_trivial }

example : finset (fin 3) := s.map f