import data.set.finite
import logic.function.iterate

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

@[simp]
lemma finset.not_nonempty (s : finset α) :
  ¬s.nonempty ↔ s = ∅ :=
begin
  classical,
  rw [finset.nonempty_iff_ne_empty, not_not],
end

namespace set

lemma finite_of_finite_image_fibers {s : set α} {f : α → β}
  (himg : finite (f '' s))
  (hfib : ∀ b, finite {a ∈ s | f a = b}) :
  finite s :=
begin
  have : s = ⋃ (b ∈ f '' s), {a ∈ s | f a = b},
  { ext a,
    rw mem_bUnion_iff,
    split,
    { intro h, exact ⟨f a, mem_image_of_mem _ h, ⟨h, rfl⟩⟩ },
    { rintro ⟨_, _, ⟨h, _⟩⟩, exact h } },
  rw this,
  exact finite.bUnion himg (λ b _, hfib b)
end

lemma infinite_of_subset {s₁ s₂ : set α} (h : s₁ ⊆ s₂) (h₁ : s₁.infinite) :
  s₂.infinite :=
begin
  rw ← infinite_coe_iff at h₁ ⊢,
  resetI,
  apply infinite.of_injective _ (set.inclusion_injective h),
end

instance Ioo.densely_ordered [preorder α] [densely_ordered α] (a b : α) :
  densely_ordered (Ioo a b) :=
begin
  constructor,
  rintros ⟨x, hx⟩ ⟨y, hy⟩ h,
  change x < y at h,
  choose z hz using exists_between h,
  exact ⟨⟨z, lt_trans hx.1 hz.1, lt_trans hz.2 hy.2⟩, hz.1, hz.2⟩,
end

lemma Ioo.infinite [preorder α] [densely_ordered α] {x y : α} (h : x < y) :
  infinite (Ioo x y) :=
begin
  obtain ⟨c, hc₁, hc₂⟩ : ∃ c : α, x < c ∧ c < y := exists_between h,
  intro f,
  letI := f.fintype,
  have : well_founded ((<) : Ioo x y → Ioo x y → Prop) :=
    fintype.well_founded_of_trans_of_irrefl _,
  obtain ⟨m, _, hm⟩ : ∃ (m : Ioo x y) _, ∀ d ∈ univ, ¬ d < m := this.has_min univ ⟨⟨c, hc₁, hc₂⟩, trivial⟩,
  obtain ⟨z, hz₁, hz₂⟩ : ∃ (z : α), x < z ∧ z < m := exists_between m.2.1,
  refine hm ⟨z, hz₁, lt_trans hz₂ m.2.2⟩ trivial hz₂
end

lemma Ico.infinite [preorder α] [densely_ordered α] {a b : α} (h : a < b) :
  infinite (Ico a b) :=
set.infinite_of_subset Ioo_subset_Ico_self (Ioo.infinite h)

lemma Ioc.infinite [preorder α] [densely_ordered α] {a b : α} (h : a < b) :
  infinite (Ioc a b) :=
set.infinite_of_subset Ioo_subset_Ioc_self (Ioo.infinite h)

lemma Icc.infinite [preorder α] [densely_ordered α] {a b : α} (h : a < b) :
  infinite (Icc a b) :=
set.infinite_of_subset Ioo_subset_Icc_self (Ioo.infinite h)

end set


/-
Copyright (c) 2021 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import algebra.category.Ring.basic
import algebra.category.Module.basic
import linear_algebra.tensor_product

open_locale tensor_product

namespace change_of_rings

namespace restriction_of_scalars

universe u

variables {R S : CommRing.{u}} -- [ring R] [ring S] -- (f : R →+* S)
variable (f : R ⟶ S)
variables (N : Module S) -- [add_comm_monoid N] [module S N]
include f

@[reducible] def module :
  Module R :=
{ carrier := N,
  is_module := module.comp_hom _ f, }.
localized "notation f `^*` N := restriction_of_scalars.module f N" in change_of_rings

def is_module : _root_.module R N := (f ^* N).is_module

localized "attribute [instance] restriction_of_scalars.is_module" in change_of_rings

instance has_scalar' : _root_.has_scalar S (f ^* N) :=
{ smul := λ s n, @has_scalar.smul S N _ s n }.

@[simp] lemma smul_def' (r : R) (n : f ^* N) : r • n = f r • n := rfl
@[simp] lemma smul_def (r : R) (n : N) :
  @has_scalar.smul R N begin
    haveI := is_module f N,
    apply_instance,
  end r n = f r • n := rfl

def compatible_smul (N₁ N₂ : Module S) :
  let m1 := is_module f N₁,
      m2 := is_module f N₂,
      m3 := is_module f ⟨S⟩ in
  begin
    resetI,
    exact linear_map.compatible_smul N₁ N₂ R S
  end :=
let m1 := is_module f N₁,
    m2 := is_module f N₂,
    m3 := is_module f ⟨S⟩ in
begin
  resetI,
  fconstructor,
  intros g r n,
  calc  g (r • n)
      = g (f r • n) : by congr' 1
    ... = f r • g n : by { erw linear_map.map_smul, },
end
/--restriction of scalar is a functor from `S`-modules to `R`-modules.-/
def functor : Module S ⥤ Module R :=
{ obj := λ N, f ^* N,
  map := λ N₁ N₂ l,
  let m1 := is_module f N₁,
      m2 := is_module f N₂,
      m3 := is_module f ⟨S⟩,
      m4 := compatible_smul f N₁ N₂ in
  begin
    dsimp only at m4,
    resetI,
    exact linear_map.restrict_scalars R l,
  end }.

localized "notation f `⥤^*` M := (restriction_of_scalars.functor f).obj M" in change_of_rings

end restriction_of_scalars

namespace extension_of_scalars

open category_theory tensor_product

universe u

variables {R S : CommRing.{u}} (f : R ⟶ S) (M : Module R)
include f

include M
localized "notation M `⊗[` R `,` f `]` S := @tensor_product R _ M S _ _ _
  (restriction_of_scalars.is_module f ⟨S⟩)" in change_of_rings
localized "notation m `⊗ₜ[` R `,` f `]` s := @tensor_product.tmul R _ _ _ _ _ _
  (restriction_of_scalars.is_module f ⟨_⟩) m s" in change_of_rings

def smul_by (s : S) : (M ⊗[R, f] S) ⟶ (M ⊗[R, f] S) :=
let m : module R S := restriction_of_scalars.is_module f ⟨S⟩ in
begin
  resetI,
  refine tensor_product.lift _,
  refine ⟨_, _, _⟩,
  { -- we define `m ↦ (s' ↦ m ⊗ (s * s'))`
    refine λ m, ⟨λ s', m ⊗ₜ[R, f] (s * s'), _, _⟩,
    { -- map_add
      intros,
      erw [mul_add, tmul_add], },
    { -- map_smul
      intros,
      rw [ring_hom.id_apply, smul_tmul', smul_tmul],
      congr' 1,
      rw [restriction_of_scalars.smul_def f ⟨S⟩, smul_eq_mul, ← mul_assoc, mul_comm s,
        mul_assoc, restriction_of_scalars.smul_def f ⟨S⟩, smul_eq_mul],
    }, },
  { intros,
    ext,
    simp only [linear_map.coe_mk, map_add, add_tmul],
    refl, },
  { intros,
    ext,
    simp only [linear_map.coe_mk, ring_hom.id_apply, linear_map.smul_apply],
    rw [tensor_product.smul_tmul'], }
end.

lemma smul_by.pure_tensor (s s' : S) (m : M) :
  (smul_by f M s (m ⊗ₜ[R, f] s')) =
  m ⊗ₜ[R, f] (s * s') :=
begin
  simp only [smul_by, tensor_product.lift.tmul, linear_map.coe_mk],
end

lemma smul_by.one : smul_by f M 1 = 𝟙 _ :=
begin
  ext,
  induction x using tensor_product.induction_on with _ _ _ _ ih1 ih2,
  { simpa only [smul_by, map_zero], },
  { simpa only [smul_by.pure_tensor, one_mul], },
  { simp only [category_theory.types_id_apply] at ih1 ih2 ⊢,
    conv_rhs { rw [← ih1, ← ih2] },
    convert map_add _ _ _, },
end.

lemma smul_by.mul (s s' : S) : smul_by f M (s * s') = smul_by f M s' ≫ smul_by f M s :=
begin
  ext,
  induction x using tensor_product.induction_on with _ _ x y ih1 ih2,
  { simp only [smul_by, map_zero, types_comp_apply], },
  { simp [smul_by, mul_assoc], },
  { convert congr_arg2 (+) ih1 ih2 using 1,
    { convert map_add _ _ _ },
    { simp only [types_comp_apply],
      calc  smul_by f M s (smul_by f M s' (x + y))
          = smul_by f M s (smul_by f M s' x + smul_by f M s' y)
          : by { congr' 1, convert map_add _ _ _}
      ... = smul_by f M s (smul_by f M s' x) + smul_by f M s (smul_by f M s' y)
          : by convert map_add _ _ _, }, }
end.

lemma smul_by.apply_zero (s : S) : smul_by f M s 0 = 0 :=
by simp only [smul_by, map_zero]

lemma smul_by.apply_add (s : S) (a b) : smul_by f M s (a + b) = smul_by f M s a + smul_by f M s b :=
by simp [smul_by, map_add]

lemma smul_by.add (s s') : smul_by f M (s + s') = smul_by f M s + smul_by f M s' :=
begin
  ext x,
  induction x using tensor_product.induction_on with _ _ x y ih1 ih2,
  { simp [smul_by], },
  { simp [smul_by, add_mul, tmul_add], },
  { simp only [pi.add_apply, smul_by.apply_add, ih1, ih2],
    rw show ∀ (a b c d : M ⊗[R, f] S), a + b + (c + d) = a + c + (b + d), from _,
    intros,
    -- `ring` doesn't work here for some reason
    rw calc a + b + (c + d) = a + (b + (c + d)) : by rw add_assoc
      ... = a + (b + c + d) : by rw add_assoc
      ... = a + (c + b + d) : by rw add_comm b c
      ... = a + (c + (b + d)) : by rw add_assoc
      ... = a + c + (b + d) : by rw add_assoc, }
end.

lemma smul_by.zero : smul_by f M 0 = 0 :=
begin
  ext,
  induction x using tensor_product.induction_on with _ _ x y ih1 ih2,
  { simp [smul_by], },
  { simp [smul_by], },
  { simp [smul_by.apply_add, ih1, ih2], }
end.

/--
Since `S` has an `R`-module structure, `M ⊗[R] S` can be given an `S`-module structure.
The scalar multiplication is defined by `s • (m ⊗ s') := m ⊗ (s * s')`
-/
@[reducible] def has_scalar_S_M_tensor_S : _root_.has_scalar S (M ⊗[R, f] S) :=
{ smul := λ s', smul_by f M s' }

local attribute [instance] has_scalar_S_M_tensor_S

lemma smul_pure_tensor (s s' : S) (m : M) :
  (s • (m ⊗ₜ[R, f] s')) =
  m ⊗ₜ[R, f] (s * s') :=
by simp only [smul_by, tensor_product.lift.tmul, linear_map.coe_mk]

@[simp] lemma smul_zero (s : S) : s • (0 : M ⊗[R, f] S) = 0 :=
by simp [smul_by]

/--
See above
-/
def mul_action_S_M_tensor_S : _root_.mul_action S (M ⊗[R, f] S) :=
{ one_smul := λ x, begin
    change smul_by _ _ _ _ = _,
    rw smul_by.one f M,
    refl,
  end,
  mul_smul := λ s s' x, begin
    change smul_by _ _ _ _ = smul_by _ _ _ (smul_by _ _ _ _),
    rw smul_by.mul f M,
    refl,
  end,
  ..(has_scalar_S_M_tensor_S f M) }.

localized "attribute [instance] extension_of_scalars.mul_action_S_M_tensor_S" in change_of_rings

def distrib_mul_action_S_M_tensor_S : _root_.distrib_mul_action S (M ⊗[R, f] S) :=
{ smul_zero := λ s, by { change smul_by f M s 0 = 0, apply smul_by.apply_zero, },
  smul_add := λ s x y, begin
    change smul_by f M s (x + y) = smul_by f M s x + smul_by f M s y,
    apply smul_by.apply_add,
  end }

def is_module : module S (M ⊗[R, f] S) :=
{ add_smul := λ s s' x, begin
    change smul_by _ _ _ _ = smul_by _ _ _ _ + smul_by _ _ _ _,
    rw smul_by.add,
    refl,
  end,
  zero_smul := λ x, begin
    change smul_by _ _ _ _ = _,
    rw smul_by.zero,
    refl,
  end,
  ..(distrib_mul_action_S_M_tensor_S f M) }.

def is_module' : module R (M ⊗[R, f] S) :=
infer_instance

localized "attribute [instance] extension_of_scalars.is_module extension_of_scalars.is_module'"
  in change_of_rings
/--
See above
-/
def module : Module S :=
{ carrier := M ⊗[R, f] S,
  is_module := is_module f M }

localized "notation f `_*` M := extension_of_scalars.module f M" in change_of_rings

omit M
/--
Extension of scalars is a functor where an `R`-module `M` is sent to `M ⊗ S` and
`l : M1 ⟶ M2` is sent to `m ⊗ s ↦ l m ⊗ s`
-/
def map {M1 M2 : Module R} (l : M1 ⟶ M2) : (f _* M1) ⟶ (f _* M2) :=
let im1 : _root_.module R S := restriction_of_scalars.is_module f ⟨S⟩,
    im2 : _root_.module R (f _* M2) := is_module' f M2 in
begin
  resetI,
  refine
    { to_fun := tensor_product.lift { to_fun := λ m1, _, map_add' := _, map_smul' := _ },
      map_add' := _,
      map_smul' := _ },
  { -- `S ⟶ f _* M2` given by `s ↦ l m ⊗ s`
    refine { to_fun := λ s, (l m1) ⊗ₜ[R, f] s, map_add' := _, map_smul' := _ },
    { -- map_add
      intros,
      rw [tmul_add], },
    { -- map_smul
      intros,
      rw [ring_hom.id_apply, restriction_of_scalars.smul_def f ⟨S⟩ r x, smul_tmul',
        smul_tmul],
      refl, } },
  { intros m m',
    ext s,
    simp only [add_tmul, map_add, linear_map.coe_mk, linear_map.add_apply], },
  { intros r m,
    ext s,
    simp only [smul_tmul, linear_map.map_smulₛₗ, tmul_smul, linear_map.coe_mk, linear_map.smul_apply], },
  { intros z1 z2,
    rw [map_add], },
  { intros s z,
    induction z using tensor_product.induction_on with _ _ z1 z2 ih1 ih2,
    { simp only [smul_zero, map_zero], },
    { simp only [smul_pure_tensor, ring_hom.id_apply, linear_map.coe_mk, lift.tmul], },
    { rw [smul_add, map_add, ring_hom.id_apply, ih1, ih2, map_add, smul_add,
        ring_hom.id_apply], } }
end

/--
The functor extension of scalars
-/
def functor : Module.{u} R ⥤ Module.{u} S :=
{ obj := λ M, f _* M,
  map := λ M1 M2 l, map f l,
  map_id' := λ M, begin
    ext x,
    rw [map, Module.id_apply],
    induction x using tensor_product.induction_on with _ _ m s ihx ihy,
    { rw map_zero },
    { rw [linear_map.coe_mk, tensor_product.lift.tmul], refl, },
    { rw [linear_map.coe_mk] at ihx ihy ⊢,
      rw [map_add, ihx, ihy], }
  end,
  map_comp' := λ M1 M2 M3 g h, begin
    ext x,
    rw [map, map, map, linear_map.coe_mk, category_theory.comp_apply,
      linear_map.coe_mk, linear_map.coe_mk],
    induction x using tensor_product.induction_on with _ _ m s ihx ihy,
    { rw [map_zero, map_zero, map_zero], },
    { rw [tensor_product.lift.tmul, tensor_product.lift.tmul], refl, },
    { rw [map_add, ihx, ihy, map_add, map_add], }
  end }

localized "notation f `⥤_*` M := (extension_of_scalars.functor f).obj M" in change_of_rings

end extension_of_scalars

section adjunction

universe u

open category_theory tensor_product
open_locale change_of_rings

variables {R S : CommRing.{u}} (f : R ⟶ S) (X : Module.{u} R) (Y : Module.{u} S)

def backward (g : X ⟶ (f ⥤^* Y)) :
  (f ⥤_* X) ⟶ Y :=
{ to_fun := λ z,
  let m1 := restriction_of_scalars.is_module f ⟨S⟩,
      m2 : module R Y := restriction_of_scalars.is_module f Y,
      m3 : module S (f ⥤^* Y) := Y.is_module in
  begin
    resetI,
    refine tensor_product.lift
      { to_fun := λ x,
          { to_fun := λ s, _,
            map_add' := _,
            map_smul' := _, },
        map_add' := _,
        map_smul' := _ } z,
    { -- `x ⊗ s ↦ s • g x` in Y
      exact s • (g x : Y) },
    { intros, rw add_smul, },
    { intros r s,
      rw [ring_hom.id_apply],
      calc  (r • s) • g x
          = (f r * s) • g x : rfl
      ... = f r • s • g x : by rw [mul_smul], },
    { intros x y,
      ext s,
      simp only [linear_map.coe_mk, smul_add, linear_map.add_apply, map_add], },
    { intros r x,
      ext s,
      simp only [linear_map.coe_mk, ring_hom.id_apply, linear_map.smul_apply,
        linear_map.map_smul],
      erw [← mul_smul, mul_comm, mul_smul],
      refl, },
  end,
  map_add' := λ z1 z2, by simp only [map_add],
  map_smul' := λ r z, begin
    rw [ring_hom.id_apply],
    induction z using tensor_product.induction_on with x y x y ih1 ih2,
    { simp only [smul_zero, map_zero], },
    { erw [extension_of_scalars.smul_pure_tensor],
      simp [tensor_product.lift.tmul, mul_smul], },
    { simp only [smul_add, map_add],
      dsimp only at ih1 ih2,
      rw [ih1, ih2], },
  end }.

def forward (g : (f ⥤_* X) ⟶ Y) :
  X ⟶ (f ⥤^* Y) :=
let m1 : module R S := restriction_of_scalars.is_module f ⟨S⟩,
    m2 : module R Y := restriction_of_scalars.is_module f Y in
{ to_fun := λ x, g (x ⊗ₜ[R, f] 1),
  map_add' := λ x x', by rw [tensor_product.add_tmul, map_add],
  map_smul' := λ r x, begin
    resetI,
    rw [ring_hom.id_apply],
    calc  g ((r • x) ⊗ₜ[R, f] (1 : S))
        = g (x ⊗ₜ[R, f] (r • 1)) : by rw smul_tmul
    ... = g (x ⊗ₜ[R, f] (f r • 1)) : by rw restriction_of_scalars.smul_def f ⟨S⟩
    ... = g (f r • (x ⊗ₜ[R, f] 1)) : by congr' 1
    ... = f r • g (x ⊗ₜ[R, f] 1) : by rw linear_map.map_smul
    ... = r • g (x ⊗ₜ[R, f] 1) : rfl,
  end }.

def equiv :
  ((extension_of_scalars.functor f).obj X ⟶ Y) ≃ (X ⟶ (restriction_of_scalars.functor f).obj Y) :=
{ to_fun := forward f X Y,
  inv_fun := backward f X Y,
  left_inv := λ g, begin
    ext z,
    induction z using tensor_product.induction_on with x s z1 z2 ih1 ih2,
    { simp only [map_zero], },
    { erw tensor_product.lift.tmul,
      simp only [linear_map.coe_mk],
      change s • g _ = _,
      rw [← linear_map.map_smul, extension_of_scalars.smul_pure_tensor, mul_one], },
    { rw [map_add, map_add, ih1, ih2], }
  end,
  right_inv := λ g, begin
    ext,
    unfold forward backward,
    simp only [linear_map.coe_mk, tensor_product.lift.tmul, one_smul],
  end }.

def unit.map : X ⟶ ((extension_of_scalars.functor f ⋙ restriction_of_scalars.functor f).obj X) :=
let m1 : module R S := restriction_of_scalars.is_module f ⟨S⟩ in
{ to_fun := λ x, x ⊗ₜ[R, f] 1,
  map_add' := λ x x', by { rw tensor_product.add_tmul, },
  map_smul' := λ r x, begin
    resetI,
    erw [smul_tmul, extension_of_scalars.smul_pure_tensor],
    congr,
  end }.

def unit : 𝟭 (Module ↥R) ⟶ extension_of_scalars.functor f ⋙ restriction_of_scalars.functor f :=
{ app := unit.map f,
  naturality' := λ X X' g, begin
    ext,
    simp only [unit.map, functor.id_map, Module.coe_comp, linear_map.coe_mk,
      function.comp_app, functor.comp_map],
    rw show (restriction_of_scalars.functor f).map ((extension_of_scalars.functor f).map g) =
      { to_fun := (extension_of_scalars.functor f).map g, map_add' := _, map_smul' := _ }, from rfl,
    simp only [linear_map.coe_mk],
    erw tensor_product.lift.tmul,
    simp only [linear_map.coe_mk],
  end }

def counit.map : (restriction_of_scalars.functor f ⋙ extension_of_scalars.functor f).obj Y ⟶ Y :=
let m1 : module R S := restriction_of_scalars.is_module f ⟨S⟩,
    m2 : module R Y := restriction_of_scalars.is_module f Y in
{ to_fun :=
    begin
      resetI,
      refine tensor_product.lift
        { to_fun := λ y,
            { to_fun := λ s, _,
              map_add' := _,
              map_smul' := _ },
          map_add' := _,
          map_smul' := _ },
      { exact s • (y : Y), },
      { intros s s', rw add_smul, },
      { intros r s,
        rw [ring_hom.id_apply, restriction_of_scalars.smul_def,
          restriction_of_scalars.smul_def f ⟨S⟩ r s, smul_eq_mul, mul_smul], },
      { intros y1 y2,
        ext,
        simp only [linear_map.coe_mk, smul_add, linear_map.add_apply], },
      { intros r y,
        ext s,
        simp only [ring_hom.id_apply, restriction_of_scalars.smul_def',
          linear_map.coe_mk, linear_map.smul_apply],
        erw [← mul_smul, mul_comm, mul_smul],
        refl, },
    end,
  map_add' := λ z1 z2, by simp only [map_add],
  map_smul' := λ s z, begin
    simp only [ring_hom.id_apply],
    induction z using tensor_product.induction_on with x s' z1 z2 ih1 ih2,
    { simp only [smul_zero, map_zero], },
    { erw extension_of_scalars.smul_pure_tensor,
      simp only [linear_map.coe_mk, tensor_product.lift.tmul],
      rw mul_smul, },
    { rw [smul_add, map_add, map_add, ih1, ih2, smul_add], },
  end }.

def counit : (restriction_of_scalars.functor f ⋙ extension_of_scalars.functor f) ⟶ (𝟭 _) :=
{ app := counit.map f,
  naturality' := λ Y Y' g, begin
    ext z,
    simp only [functor.comp_map, Module.coe_comp, function.comp_app, functor.id_map],
    induction z using tensor_product.induction_on with y s z1 z2 ih1 ih2,
    { simp only [map_zero], },
    { unfold counit.map,
      erw [tensor_product.lift.tmul, tensor_product.lift.tmul],
      simp only [linear_map.coe_mk, linear_map.map_smulₛₗ, ring_hom.id_apply],
      refl, },
    { rw [map_add, map_add, ih1, ih2, map_add, map_add], }
  end }.

def adjunction : adjunction (extension_of_scalars.functor f) (restriction_of_scalars.functor f) :=
{ hom_equiv := equiv f,
  unit := unit f,
  counit := counit f,
  hom_equiv_unit' := λ X Y g, begin
    ext x,
    unfold equiv unit,
    simp only [equiv.coe_fn_mk, Module.coe_comp, function.comp_app],
    unfold unit.map forward,
    simp only [linear_map.coe_mk],
    refl,
  end,
  hom_equiv_counit' := λ X Y g, begin
    ext z,
    unfold equiv counit,
    simp only [equiv.coe_fn_symm_mk, Module.coe_comp, function.comp_app],
    unfold backward counit.map,
    simp only [linear_map.coe_mk],
    induction z using tensor_product.induction_on with x s z1 z2 ih1 ih2,
    { simp only [map_zero], },
    { erw tensor_product.lift.tmul, },
    { simp only [map_add, ih1, ih2], }
  end }.

end adjunction

end change_of_rings


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.bag_inter
import Mathlib.data.list.erase_dup
import Mathlib.data.list.zip
import Mathlib.logic.relation
import Mathlib.data.nat.factorial
import Mathlib.PostPort

universes uu u_1 vv

namespace Mathlib

/-!
# List permutations
-/

namespace list

/-- `perm l₁ l₂` or `l₁ ~ l₂` asserts that `l₁` and `l₂` are permutations
  of each other. This is defined by induction using pairwise swaps. -/
inductive perm {α : Type uu} : List α → List α → Prop
where
| nil : perm [] []
| cons : ∀ (x : α) {l₁ l₂ : List α}, perm l₁ l₂ → perm (x :: l₁) (x :: l₂)
| swap : ∀ (x y : α) (l : List α), perm (y :: x :: l) (x :: y :: l)
| trans : ∀ {l₁ l₂ l₃ : List α}, perm l₁ l₂ → perm l₂ l₃ → perm l₁ l₃

infixl:50 " ~ " => Mathlib.list.perm

protected theorem perm.refl {α : Type uu} (l : List α) : l ~ l := sorry

protected theorem perm.symm {α : Type uu} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : l₂ ~ l₁ :=
  perm.rec_on p perm.nil (fun (x : α) (l₁ l₂ : List α) (p₁ : l₁ ~ l₂) (r₁ : l₂ ~ l₁) => perm.cons x r₁)
    (fun (x y : α) (l : List α) => perm.swap y x l)
    fun (l₁ l₂ l₃ : List α) (p₁ : l₁ ~ l₂) (p₂ : l₂ ~ l₃) (r₁ : l₂ ~ l₁) (r₂ : l₃ ~ l₂) => perm.trans r₂ r₁

theorem perm_comm {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ ~ l₂ ↔ l₂ ~ l₁ :=
  { mp := perm.symm, mpr := perm.symm }

theorem perm.swap' {α : Type uu} (x : α) (y : α) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : y :: x :: l₁ ~ x :: y :: l₂ :=
  perm.trans (perm.swap x y l₁) (perm.cons x (perm.cons y p))

theorem perm.eqv (α : Type u_1) : equivalence perm :=
  mk_equivalence perm perm.refl perm.symm perm.trans

protected instance is_setoid (α : Type u_1) : setoid (List α) :=
  setoid.mk perm (perm.eqv α)

theorem perm.subset {α : Type uu} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : l₁ ⊆ l₂ := sorry

theorem perm.mem_iff {α : Type uu} {a : α} {l₁ : List α} {l₂ : List α} (h : l₁ ~ l₂) : a ∈ l₁ ↔ a ∈ l₂ :=
  { mp := fun (m : a ∈ l₁) => perm.subset h m, mpr := fun (m : a ∈ l₂) => perm.subset (perm.symm h) m }

theorem perm.append_right {α : Type uu} {l₁ : List α} {l₂ : List α} (t₁ : List α) (p : l₁ ~ l₂) : l₁ ++ t₁ ~ l₂ ++ t₁ := sorry

theorem perm.append_left {α : Type uu} {t₁ : List α} {t₂ : List α} (l : List α) : t₁ ~ t₂ → l ++ t₁ ~ l ++ t₂ := sorry

theorem perm.append {α : Type uu} {l₁ : List α} {l₂ : List α} {t₁ : List α} {t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ++ t₁ ~ l₂ ++ t₂ :=
  perm.trans (perm.append_right t₁ p₁) (perm.append_left l₂ p₂)

theorem perm.append_cons {α : Type uu} (a : α) {h₁ : List α} {h₂ : List α} {t₁ : List α} {t₂ : List α} (p₁ : h₁ ~ h₂) (p₂ : t₁ ~ t₂) : h₁ ++ a :: t₁ ~ h₂ ++ a :: t₂ :=
  perm.append p₁ (perm.cons a p₂)

@[simp] theorem perm_middle {α : Type uu} {a : α} {l₁ : List α} {l₂ : List α} : l₁ ++ a :: l₂ ~ a :: (l₁ ++ l₂) := sorry

@[simp] theorem perm_append_singleton {α : Type uu} (a : α) (l : List α) : l ++ [a] ~ a :: l :=
  perm.trans perm_middle
    (eq.mpr (id (Eq._oldrec (Eq.refl (a :: (l ++ []) ~ a :: l)) (append_nil l))) (perm.refl (a :: l)))

theorem perm_append_comm {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ ++ l₂ ~ l₂ ++ l₁ := sorry

theorem concat_perm {α : Type uu} (l : List α) (a : α) : concat l a ~ a :: l := sorry

theorem perm.length_eq {α : Type uu} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : length l₁ = length l₂ := sorry

theorem perm.eq_nil {α : Type uu} {l : List α} (p : l ~ []) : l = [] :=
  eq_nil_of_length_eq_zero (perm.length_eq p)

theorem perm.nil_eq {α : Type uu} {l : List α} (p : [] ~ l) : [] = l :=
  Eq.symm (perm.eq_nil (perm.symm p))

theorem perm_nil {α : Type uu} {l₁ : List α} : l₁ ~ [] ↔ l₁ = [] :=
  { mp := fun (p : l₁ ~ []) => perm.eq_nil p, mpr := fun (e : l₁ = []) => e ▸ perm.refl l₁ }

theorem not_perm_nil_cons {α : Type uu} (x : α) (l : List α) : ¬[] ~ x :: l :=
  fun (ᾰ : [] ~ x :: l) =>
    idRhs (list.no_confusion_type False (x :: l) []) (list.no_confusion (perm.eq_nil (perm.symm ᾰ)))

@[simp] theorem reverse_perm {α : Type uu} (l : List α) : reverse l ~ l := sorry

theorem perm_cons_append_cons {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} (a : α) (p : l ~ l₁ ++ l₂) : a :: l ~ l₁ ++ a :: l₂ :=
  perm.trans (perm.cons a p) (perm.symm perm_middle)

@[simp] theorem perm_repeat {α : Type uu} {a : α} {n : ℕ} {l : List α} : l ~ repeat a n ↔ l = repeat a n := sorry

@[simp] theorem repeat_perm {α : Type uu} {a : α} {n : ℕ} {l : List α} : repeat a n ~ l ↔ repeat a n = l :=
  iff.trans (iff.trans perm_comm perm_repeat) eq_comm

@[simp] theorem perm_singleton {α : Type uu} {a : α} {l : List α} : l ~ [a] ↔ l = [a] :=
  perm_repeat

@[simp] theorem singleton_perm {α : Type uu} {a : α} {l : List α} : [a] ~ l ↔ [a] = l :=
  repeat_perm

theorem perm.eq_singleton {α : Type uu} {a : α} {l : List α} (p : l ~ [a]) : l = [a] :=
  iff.mp perm_singleton p

theorem perm.singleton_eq {α : Type uu} {a : α} {l : List α} (p : [a] ~ l) : [a] = l :=
  Eq.symm (perm.eq_singleton (perm.symm p))

theorem singleton_perm_singleton {α : Type uu} {a : α} {b : α} : [a] ~ [b] ↔ a = b := sorry

theorem perm_cons_erase {α : Type uu} [DecidableEq α] {a : α} {l : List α} (h : a ∈ l) : l ~ a :: list.erase l a := sorry

theorem perm_induction_on {α : Type uu} {P : List α → List α → Prop} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) (h₁ : P [] []) (h₂ : ∀ (x : α) (l₁ l₂ : List α), l₁ ~ l₂ → P l₁ l₂ → P (x :: l₁) (x :: l₂)) (h₃ : ∀ (x y : α) (l₁ l₂ : List α), l₁ ~ l₂ → P l₁ l₂ → P (y :: x :: l₁) (x :: y :: l₂)) (h₄ : ∀ (l₁ l₂ l₃ : List α), l₁ ~ l₂ → l₂ ~ l₃ → P l₁ l₂ → P l₂ l₃ → P l₁ l₃) : P l₁ l₂ :=
  (fun (P_refl : ∀ (l : List α), P l l) =>
      perm.rec_on p h₁ h₂ (fun (x y : α) (l : List α) => h₃ x y l l (perm.refl l) (P_refl l)) h₄)
    fun (l : List α) => list.rec_on l h₁ fun (x : α) (xs : List α) (ih : P xs xs) => h₂ x xs xs (perm.refl xs) ih

theorem perm.filter_map {α : Type uu} {β : Type vv} (f : α → Option β) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : filter_map f l₁ ~ filter_map f l₂ := sorry

theorem perm.map {α : Type uu} {β : Type vv} (f : α → β) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : map f l₁ ~ map f l₂ :=
  filter_map_eq_map f ▸ perm.filter_map (some ∘ f) p

theorem perm.pmap {α : Type uu} {β : Type vv} {p : α → Prop} (f : (a : α) → p a → β) {l₁ : List α} {l₂ : List α} : l₁ ~ l₂ → ∀ {H₁ : ∀ (a : α), a ∈ l₁ → p a} {H₂ : ∀ (a : α), a ∈ l₂ → p a}, pmap f l₁ H₁ ~ pmap f l₂ H₂ := sorry

theorem perm.filter {α : Type uu} (p : α → Prop) [decidable_pred p] {l₁ : List α} {l₂ : List α} (s : l₁ ~ l₂) : filter p l₁ ~ filter p l₂ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (filter p l₁ ~ filter p l₂)) (Eq.symm (filter_map_eq_filter p))))
    (perm.filter_map (option.guard p) s)

theorem exists_perm_sublist {α : Type uu} {l₁ : List α} {l₂ : List α} {l₂' : List α} (s : l₁ <+ l₂) (p : l₂ ~ l₂') : ∃ (l₁' : List α), ∃ (H : l₁' ~ l₁), l₁' <+ l₂' := sorry

theorem perm.sizeof_eq_sizeof {α : Type uu} [SizeOf α] {l₁ : List α} {l₂ : List α} (h : l₁ ~ l₂) : list.sizeof l₁ = list.sizeof l₂ := sorry

theorem perm_comp_perm {α : Type uu} : relation.comp perm perm = perm := sorry

theorem perm_comp_forall₂ {α : Type uu} {β : Type vv} {r : α → β → Prop} {l : List α} {u : List α} {v : List β} (hlu : l ~ u) (huv : forall₂ r u v) : relation.comp (forall₂ r) perm l v := sorry

theorem forall₂_comp_perm_eq_perm_comp_forall₂ {α : Type uu} {β : Type vv} {r : α → β → Prop} : relation.comp (forall₂ r) perm = relation.comp perm (forall₂ r) := sorry

theorem rel_perm_imp {α : Type uu} {β : Type vv} {r : α → β → Prop} (hr : relator.right_unique r) : relator.lift_fun (forall₂ r) (forall₂ r ⇒ implies) perm perm := sorry

theorem rel_perm {α : Type uu} {β : Type vv} {r : α → β → Prop} (hr : relator.bi_unique r) : relator.lift_fun (forall₂ r) (forall₂ r ⇒ Iff) perm perm := sorry

/-- `subperm l₁ l₂`, denoted `l₁ <+~ l₂`, means that `l₁` is a sublist of
  a permutation of `l₂`. This is an analogue of `l₁ ⊆ l₂` which respects
  multiplicities of elements, and is used for the `≤` relation on multisets. -/
def subperm {α : Type uu} (l₁ : List α) (l₂ : List α) :=
  ∃ (l : List α), ∃ (H : l ~ l₁), l <+ l₂

infixl:50 " <+~ " => Mathlib.list.subperm

theorem nil_subperm {α : Type uu} {l : List α} : [] <+~ l :=
  Exists.intro []
    (Exists.intro perm.nil
      (eq.mpr (id (propext ((fun {α : Type uu} (l : List α) => iff_true_intro (nil_sublist l)) l))) trivial))

theorem perm.subperm_left {α : Type uu} {l : List α} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : l <+~ l₁ ↔ l <+~ l₂ := sorry

theorem perm.subperm_right {α : Type uu} {l₁ : List α} {l₂ : List α} {l : List α} (p : l₁ ~ l₂) : l₁ <+~ l ↔ l₂ <+~ l := sorry

theorem sublist.subperm {α : Type uu} {l₁ : List α} {l₂ : List α} (s : l₁ <+ l₂) : l₁ <+~ l₂ :=
  Exists.intro l₁ (Exists.intro (perm.refl l₁) s)

theorem perm.subperm {α : Type uu} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : l₁ <+~ l₂ :=
  Exists.intro l₂ (Exists.intro (perm.symm p) (sublist.refl l₂))

theorem subperm.refl {α : Type uu} (l : List α) : l <+~ l :=
  perm.subperm (perm.refl l)

theorem subperm.trans {α : Type uu} {l₁ : List α} {l₂ : List α} {l₃ : List α} : l₁ <+~ l₂ → l₂ <+~ l₃ → l₁ <+~ l₃ := sorry

theorem subperm.length_le {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ <+~ l₂ → length l₁ ≤ length l₂ := sorry

theorem subperm.perm_of_length_le {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ <+~ l₂ → length l₂ ≤ length l₁ → l₁ ~ l₂ := sorry

theorem subperm.antisymm {α : Type uu} {l₁ : List α} {l₂ : List α} (h₁ : l₁ <+~ l₂) (h₂ : l₂ <+~ l₁) : l₁ ~ l₂ :=
  subperm.perm_of_length_le h₁ (subperm.length_le h₂)

theorem subperm.subset {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ <+~ l₂ → l₁ ⊆ l₂ := sorry

theorem sublist.exists_perm_append {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ <+ l₂ → ∃ (l : List α), l₂ ~ l₁ ++ l := sorry

theorem perm.countp_eq {α : Type uu} (p : α → Prop) [decidable_pred p] {l₁ : List α} {l₂ : List α} (s : l₁ ~ l₂) : countp p l₁ = countp p l₂ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (countp p l₁ = countp p l₂)) (countp_eq_length_filter p l₁)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (length (filter p l₁) = countp p l₂)) (countp_eq_length_filter p l₂)))
      (perm.length_eq (perm.filter p s)))

theorem subperm.countp_le {α : Type uu} (p : α → Prop) [decidable_pred p] {l₁ : List α} {l₂ : List α} : l₁ <+~ l₂ → countp p l₁ ≤ countp p l₂ := sorry

theorem perm.count_eq {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) (a : α) : count a l₁ = count a l₂ :=
  perm.countp_eq (Eq a) p

theorem subperm.count_le {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (s : l₁ <+~ l₂) (a : α) : count a l₁ ≤ count a l₂ :=
  subperm.countp_le (Eq a) s

theorem perm.foldl_eq' {α : Type uu} {β : Type vv} {f : β → α → β} {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : (∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₁ → ∀ (z : β), f (f z x) y = f (f z y) x) → ∀ (b : β), foldl f b l₁ = foldl f b l₂ := sorry

theorem perm.foldl_eq {α : Type uu} {β : Type vv} {f : β → α → β} {l₁ : List α} {l₂ : List α} (rcomm : right_commutative f) (p : l₁ ~ l₂) (b : β) : foldl f b l₁ = foldl f b l₂ :=
  perm.foldl_eq' p fun (x : α) (hx : x ∈ l₁) (y : α) (hy : y ∈ l₁) (z : β) => rcomm z x y

theorem perm.foldr_eq {α : Type uu} {β : Type vv} {f : α → β → β} {l₁ : List α} {l₂ : List α} (lcomm : left_commutative f) (p : l₁ ~ l₂) (b : β) : foldr f b l₁ = foldr f b l₂ := sorry

theorem perm.rec_heq {α : Type uu} {β : List α → Sort u_1} {f : (a : α) → (l : List α) → β l → β (a :: l)} {b : β []} {l : List α} {l' : List α} (hl : l ~ l') (f_congr : ∀ {a : α} {l l' : List α} {b : β l} {b' : β l'}, l ~ l' → b == b' → f a l b == f a l' b') (f_swap : ∀ {a a' : α} {l : List α} {b : β l}, f a (a' :: l) (f a' l b) == f a' (a :: l) (f a l b)) : List.rec b f l == List.rec b f l' := sorry

theorem perm.fold_op_eq {α : Type uu} {op : α → α → α} [is_associative α op] [is_commutative α op] {l₁ : List α} {l₂ : List α} {a : α} (h : l₁ ~ l₂) : foldl op a l₁ = foldl op a l₂ :=
  perm.foldl_eq (right_comm op is_commutative.comm is_associative.assoc) h a

/-- If elements of a list commute with each other, then their product does not
depend on the order of elements-/
theorem perm.sum_eq' {α : Type uu} [add_monoid α] {l₁ : List α} {l₂ : List α} (h : l₁ ~ l₂) (hc : pairwise (fun (x y : α) => x + y = y + x) l₁) : sum l₁ = sum l₂ := sorry

theorem perm.sum_eq {α : Type uu} [add_comm_monoid α] {l₁ : List α} {l₂ : List α} (h : l₁ ~ l₂) : sum l₁ = sum l₂ :=
  perm.fold_op_eq h

theorem sum_reverse {α : Type uu} [add_comm_monoid α] (l : List α) : sum (reverse l) = sum l :=
  perm.sum_eq (reverse_perm l)

theorem perm_inv_core {α : Type uu} {a : α} {l₁ : List α} {l₂ : List α} {r₁ : List α} {r₂ : List α} : l₁ ++ a :: r₁ ~ l₂ ++ a :: r₂ → l₁ ++ r₁ ~ l₂ ++ r₂ := sorry

theorem perm.cons_inv {α : Type uu} {a : α} {l₁ : List α} {l₂ : List α} : a :: l₁ ~ a :: l₂ → l₁ ~ l₂ :=
  perm_inv_core

@[simp] theorem perm_cons {α : Type uu} (a : α) {l₁ : List α} {l₂ : List α} : a :: l₁ ~ a :: l₂ ↔ l₁ ~ l₂ :=
  { mp := perm.cons_inv, mpr := perm.cons a }

theorem perm_append_left_iff {α : Type uu} {l₁ : List α} {l₂ : List α} (l : List α) : l ++ l₁ ~ l ++ l₂ ↔ l₁ ~ l₂ := sorry

theorem perm_append_right_iff {α : Type uu} {l₁ : List α} {l₂ : List α} (l : List α) : l₁ ++ l ~ l₂ ++ l ↔ l₁ ~ l₂ := sorry

theorem perm_option_to_list {α : Type uu} {o₁ : Option α} {o₂ : Option α} : option.to_list o₁ ~ option.to_list o₂ ↔ o₁ = o₂ := sorry

theorem subperm_cons {α : Type uu} (a : α) {l₁ : List α} {l₂ : List α} : a :: l₁ <+~ a :: l₂ ↔ l₁ <+~ l₂ := sorry

theorem cons_subperm_of_mem {α : Type uu} {a : α} {l₁ : List α} {l₂ : List α} (d₁ : nodup l₁) (h₁ : ¬a ∈ l₁) (h₂ : a ∈ l₂) (s : l₁ <+~ l₂) : a :: l₁ <+~ l₂ := sorry

theorem subperm_append_left {α : Type uu} {l₁ : List α} {l₂ : List α} (l : List α) : l ++ l₁ <+~ l ++ l₂ ↔ l₁ <+~ l₂ := sorry

theorem subperm_append_right {α : Type uu} {l₁ : List α} {l₂ : List α} (l : List α) : l₁ ++ l <+~ l₂ ++ l ↔ l₁ <+~ l₂ :=
  iff.trans (iff.trans (perm.subperm_left perm_append_comm) (perm.subperm_right perm_append_comm)) (subperm_append_left l)

theorem subperm.exists_of_length_lt {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ <+~ l₂ → length l₁ < length l₂ → ∃ (a : α), a :: l₁ <+~ l₂ := sorry

theorem subperm_of_subset_nodup {α : Type uu} {l₁ : List α} {l₂ : List α} (d : nodup l₁) (H : l₁ ⊆ l₂) : l₁ <+~ l₂ := sorry

theorem perm_ext {α : Type uu} {l₁ : List α} {l₂ : List α} (d₁ : nodup l₁) (d₂ : nodup l₂) : l₁ ~ l₂ ↔ ∀ (a : α), a ∈ l₁ ↔ a ∈ l₂ := sorry

theorem nodup.sublist_ext {α : Type uu} {l₁ : List α} {l₂ : List α} {l : List α} (d : nodup l) (s₁ : l₁ <+ l) (s₂ : l₂ <+ l) : l₁ ~ l₂ ↔ l₁ = l₂ := sorry

-- attribute [congr]

theorem perm.erase {α : Type uu} [DecidableEq α] (a : α) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : list.erase l₁ a ~ list.erase l₂ a := sorry

theorem subperm_cons_erase {α : Type uu} [DecidableEq α] (a : α) (l : List α) : l <+~ a :: list.erase l a := sorry

theorem erase_subperm {α : Type uu} [DecidableEq α] (a : α) (l : List α) : list.erase l a <+~ l :=
  sublist.subperm (erase_sublist a l)

theorem subperm.erase {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (a : α) (h : l₁ <+~ l₂) : list.erase l₁ a <+~ list.erase l₂ a := sorry

theorem perm.diff_right {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (t : List α) (h : l₁ ~ l₂) : list.diff l₁ t ~ list.diff l₂ t := sorry

theorem perm.diff_left {α : Type uu} [DecidableEq α] (l : List α) {t₁ : List α} {t₂ : List α} (h : t₁ ~ t₂) : list.diff l t₁ = list.diff l t₂ := sorry

theorem perm.diff {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} {t₁ : List α} {t₂ : List α} (hl : l₁ ~ l₂) (ht : t₁ ~ t₂) : list.diff l₁ t₁ ~ list.diff l₂ t₂ :=
  perm.diff_left l₂ ht ▸ perm.diff_right t₁ hl

theorem subperm.diff_right {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (h : l₁ <+~ l₂) (t : List α) : list.diff l₁ t <+~ list.diff l₂ t := sorry

theorem erase_cons_subperm_cons_erase {α : Type uu} [DecidableEq α] (a : α) (b : α) (l : List α) : list.erase (a :: l) b <+~ a :: list.erase l b := sorry

theorem subperm_cons_diff {α : Type uu} [DecidableEq α] {a : α} {l₁ : List α} {l₂ : List α} : list.diff (a :: l₁) l₂ <+~ a :: list.diff l₁ l₂ := sorry

theorem subset_cons_diff {α : Type uu} [DecidableEq α] {a : α} {l₁ : List α} {l₂ : List α} : list.diff (a :: l₁) l₂ ⊆ a :: list.diff l₁ l₂ :=
  subperm.subset subperm_cons_diff

theorem perm.bag_inter_right {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (t : List α) (h : l₁ ~ l₂) : list.bag_inter l₁ t ~ list.bag_inter l₂ t := sorry

theorem perm.bag_inter_left {α : Type uu} [DecidableEq α] (l : List α) {t₁ : List α} {t₂ : List α} (p : t₁ ~ t₂) : list.bag_inter l t₁ = list.bag_inter l t₂ := sorry

theorem perm.bag_inter {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} {t₁ : List α} {t₂ : List α} (hl : l₁ ~ l₂) (ht : t₁ ~ t₂) : list.bag_inter l₁ t₁ ~ list.bag_inter l₂ t₂ :=
  perm.bag_inter_left l₂ ht ▸ perm.bag_inter_right t₁ hl

theorem cons_perm_iff_perm_erase {α : Type uu} [DecidableEq α] {a : α} {l₁ : List α} {l₂ : List α} : a :: l₁ ~ l₂ ↔ a ∈ l₂ ∧ l₁ ~ list.erase l₂ a := sorry

theorem perm_iff_count {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} : l₁ ~ l₂ ↔ ∀ (a : α), count a l₁ = count a l₂ := sorry

protected instance decidable_perm {α : Type uu} [DecidableEq α] (l₁ : List α) (l₂ : List α) : Decidable (l₁ ~ l₂) :=
  sorry

-- @[congr]

theorem perm.erase_dup {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : erase_dup l₁ ~ erase_dup l₂ := sorry

-- attribute [congr]

theorem perm.insert {α : Type uu} [DecidableEq α] (a : α) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : insert a l₁ ~ insert a l₂ := sorry

theorem perm_insert_swap {α : Type uu} [DecidableEq α] (x : α) (y : α) (l : List α) : insert x (insert y l) ~ insert y (insert x l) := sorry

theorem perm_insert_nth {α : Type u_1} (x : α) (l : List α) {n : ℕ} (h : n ≤ length l) : insert_nth n x l ~ x :: l := sorry

theorem perm.union_right {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (t₁ : List α) (h : l₁ ~ l₂) : l₁ ∪ t₁ ~ l₂ ∪ t₁ := sorry

theorem perm.union_left {α : Type uu} [DecidableEq α] (l : List α) {t₁ : List α} {t₂ : List α} (h : t₁ ~ t₂) : l ∪ t₁ ~ l ∪ t₂ := sorry

-- @[congr]

theorem perm.union {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} {t₁ : List α} {t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ∪ t₁ ~ l₂ ∪ t₂ :=
  perm.trans (perm.union_right t₁ p₁) (perm.union_left l₂ p₂)

theorem perm.inter_right {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} (t₁ : List α) : l₁ ~ l₂ → l₁ ∩ t₁ ~ l₂ ∩ t₁ :=
  perm.filter fun (_x : α) => _x ∈ t₁

theorem perm.inter_left {α : Type uu} [DecidableEq α] (l : List α) {t₁ : List α} {t₂ : List α} (p : t₁ ~ t₂) : l ∩ t₁ = l ∩ t₂ := sorry

-- @[congr]

theorem perm.inter {α : Type uu} [DecidableEq α] {l₁ : List α} {l₂ : List α} {t₁ : List α} {t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ∩ t₁ ~ l₂ ∩ t₂ :=
  perm.inter_left l₂ p₂ ▸ perm.inter_right t₁ p₁

theorem perm.inter_append {α : Type uu} [DecidableEq α] {l : List α} {t₁ : List α} {t₂ : List α} (h : disjoint t₁ t₂) : l ∩ (t₁ ++ t₂) ~ l ∩ t₁ ++ l ∩ t₂ := sorry

theorem perm.pairwise_iff {α : Type uu} {R : α → α → Prop} (S : symmetric R) {l₁ : List α} {l₂ : List α} (p : l₁ ~ l₂) : pairwise R l₁ ↔ pairwise R l₂ := sorry

theorem perm.nodup_iff {α : Type uu} {l₁ : List α} {l₂ : List α} : l₁ ~ l₂ → (nodup l₁ ↔ nodup l₂) :=
  perm.pairwise_iff ne.symm

theorem perm.bind_right {α : Type uu} {β : Type vv} {l₁ : List α} {l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : list.bind l₁ f ~ list.bind l₂ f := sorry

theorem perm.bind_left {α : Type uu} {β : Type vv} (l : List α) {f : α → List β} {g : α → List β} (h : ∀ (a : α), f a ~ g a) : list.bind l f ~ list.bind l g := sorry

theorem perm.product_right {α : Type uu} {β : Type vv} {l₁ : List α} {l₂ : List α} (t₁ : List β) (p : l₁ ~ l₂) : product l₁ t₁ ~ product l₂ t₁ :=
  perm.bind_right (fun (a : α) => map (Prod.mk a) t₁) p

theorem perm.product_left {α : Type uu} {β : Type vv} (l : List α) {t₁ : List β} {t₂ : List β} (p : t₁ ~ t₂) : product l t₁ ~ product l t₂ :=
  perm.bind_left l fun (a : α) => perm.map (Prod.mk a) p

theorem perm.product {α : Type uu} {β : Type vv} {l₁ : List α} {l₂ : List α} {t₁ : List β} {t₂ : List β} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : product l₁ t₁ ~ product l₂ t₂ :=
  perm.trans (perm.product_right t₁ p₁) (perm.product_left l₂ p₂)

theorem sublists_cons_perm_append {α : Type uu} (a : α) (l : List α) : sublists (a :: l) ~ sublists l ++ map (List.cons a) (sublists l) := sorry

theorem sublists_perm_sublists' {α : Type uu} (l : List α) : sublists l ~ sublists' l := sorry

theorem revzip_sublists {α : Type uu} (l : List α) (l₁ : List α) (l₂ : List α) : (l₁, l₂) ∈ revzip (sublists l) → l₁ ++ l₂ ~ l := sorry

theorem revzip_sublists' {α : Type uu} (l : List α) (l₁ : List α) (l₂ : List α) : (l₁, l₂) ∈ revzip (sublists' l) → l₁ ++ l₂ ~ l := sorry

theorem perm_lookmap {α : Type uu} (f : α → Option α) {l₁ : List α} {l₂ : List α} (H : pairwise (fun (a b : α) => ∀ (c : α), c ∈ f a → ∀ (d : α), d ∈ f b → a = b ∧ c = d) l₁) (p : l₁ ~ l₂) : lookmap f l₁ ~ lookmap f l₂ := sorry

theorem perm.erasep {α : Type uu} (f : α → Prop) [decidable_pred f] {l₁ : List α} {l₂ : List α} (H : pairwise (fun (a b : α) => f a → f b → False) l₁) (p : l₁ ~ l₂) : erasep f l₁ ~ erasep f l₂ := sorry

theorem perm.take_inter {α : Type u_1} [DecidableEq α] {xs : List α} {ys : List α} (n : ℕ) (h : xs ~ ys) (h' : nodup ys) : take n xs ~ list.inter ys (take n xs) := sorry

theorem perm.drop_inter {α : Type u_1} [DecidableEq α] {xs : List α} {ys : List α} (n : ℕ) (h : xs ~ ys) (h' : nodup ys) : drop n xs ~ list.inter ys (drop n xs) := sorry

theorem perm.slice_inter {α : Type u_1} [DecidableEq α] {xs : List α} {ys : List α} (n : ℕ) (m : ℕ) (h : xs ~ ys) (h' : nodup ys) : slice n m xs ~ ys ∩ slice n m xs := sorry

/- enumerating permutations -/

theorem permutations_aux2_fst {α : Type uu} {β : Type vv} (t : α) (ts : List α) (r : List β) (ys : List α) (f : List α → β) : prod.fst (permutations_aux2 t ts r ys f) = ys ++ ts := sorry

@[simp] theorem permutations_aux2_snd_nil {α : Type uu} {β : Type vv} (t : α) (ts : List α) (r : List β) (f : List α → β) : prod.snd (permutations_aux2 t ts r [] f) = r :=
  rfl

@[simp] theorem permutations_aux2_snd_cons {α : Type uu} {β : Type vv} (t : α) (ts : List α) (r : List β) (y : α) (ys : List α) (f : List α → β) : prod.snd (permutations_aux2 t ts r (y :: ys) f) =
  f (t :: y :: ys ++ ts) :: prod.snd (permutations_aux2 t ts r ys fun (x : List α) => f (y :: x)) := sorry

theorem permutations_aux2_append {α : Type uu} {β : Type vv} (t : α) (ts : List α) (r : List β) (ys : List α) (f : List α → β) : prod.snd (permutations_aux2 t ts [] ys f) ++ r = prod.snd (permutations_aux2 t ts r ys f) := sorry

theorem mem_permutations_aux2 {α : Type uu} {t : α} {ts : List α} {ys : List α} {l : List α} {l' : List α} : l' ∈ prod.snd (permutations_aux2 t ts [] ys (append l)) ↔
  ∃ (l₁ : List α), ∃ (l₂ : List α), l₂ ≠ [] ∧ ys = l₁ ++ l₂ ∧ l' = l ++ l₁ ++ t :: l₂ ++ ts := sorry

theorem mem_permutations_aux2' {α : Type uu} {t : α} {ts : List α} {ys : List α} {l : List α} : l ∈ prod.snd (permutations_aux2 t ts [] ys id) ↔
  ∃ (l₁ : List α), ∃ (l₂ : List α), l₂ ≠ [] ∧ ys = l₁ ++ l₂ ∧ l = l₁ ++ t :: l₂ ++ ts := sorry

theorem length_permutations_aux2 {α : Type uu} {β : Type vv} (t : α) (ts : List α) (ys : List α) (f : List α → β) : length (prod.snd (permutations_aux2 t ts [] ys f)) = length ys := sorry

theorem foldr_permutations_aux2 {α : Type uu} (t : α) (ts : List α) (r : List (List α)) (L : List (List α)) : foldr (fun (y : List α) (r : List (List α)) => prod.snd (permutations_aux2 t ts r y id)) r L =
  (list.bind L fun (y : List α) => prod.snd (permutations_aux2 t ts [] y id)) ++ r := sorry

theorem mem_foldr_permutations_aux2 {α : Type uu} {t : α} {ts : List α} {r : List (List α)} {L : List (List α)} {l' : List α} : l' ∈ foldr (fun (y : List α) (r : List (List α)) => prod.snd (permutations_aux2 t ts r y id)) r L ↔
  l' ∈ r ∨ ∃ (l₁ : List α), ∃ (l₂ : List α), l₁ ++ l₂ ∈ L ∧ l₂ ≠ [] ∧ l' = l₁ ++ t :: l₂ ++ ts := sorry

theorem length_foldr_permutations_aux2 {α : Type uu} (t : α) (ts : List α) (r : List (List α)) (L : List (List α)) : length (foldr (fun (y : List α) (r : List (List α)) => prod.snd (permutations_aux2 t ts r y id)) r L) =
  sum (map length L) + length r := sorry

theorem length_foldr_permutations_aux2' {α : Type uu} (t : α) (ts : List α) (r : List (List α)) (L : List (List α)) (n : ℕ) (H : ∀ (l : List α), l ∈ L → length l = n) : length (foldr (fun (y : List α) (r : List (List α)) => prod.snd (permutations_aux2 t ts r y id)) r L) =
  n * length L + length r := sorry

theorem perm_of_mem_permutations_aux {α : Type uu} {ts : List α} {is : List α} {l : List α} : l ∈ permutations_aux ts is → l ~ ts ++ is := sorry

theorem perm_of_mem_permutations {α : Type uu} {l₁ : List α} {l₂ : List α} (h : l₁ ∈ permutations l₂) : l₁ ~ l₂ :=
  or.elim (eq_or_mem_of_mem_cons h) (fun (e : l₁ = l₂) => e ▸ perm.refl l₁)
    fun (m : l₁ ∈ permutations_aux l₂ []) => append_nil l₂ ▸ perm_of_mem_permutations_aux m

theorem length_permutations_aux {α : Type uu} (ts : List α) (is : List α) : length (permutations_aux ts is) + nat.factorial (length is) = nat.factorial (length ts + length is) := sorry

theorem length_permutations {α : Type uu} (l : List α) : length (permutations l) = nat.factorial (length l) :=
  length_permutations_aux l []

theorem mem_permutations_of_perm_lemma {α : Type uu} {is : List α} {l : List α} (H : l ~ [] ++ is → (∃ (ts' : List α), ∃ (H : ts' ~ []), l = ts' ++ is) ∨ l ∈ permutations_aux is []) : l ~ is → l ∈ permutations is := sorry

theorem mem_permutations_aux_of_perm {α : Type uu} {ts : List α} {is : List α} {l : List α} : l ~ is ++ ts → (∃ (is' : List α), ∃ (H : is' ~ is), l = is' ++ ts) ∨ l ∈ permutations_aux ts is := sorry

@[simp] theorem mem_permutations {α : Type uu} (s : List α) (t : List α) : s ∈ permutations t ↔ s ~ t :=
  { mp := perm_of_mem_permutations, mpr := mem_permutations_of_perm_lemma mem_permutations_aux_of_perm }