/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen,
  Frédéric Dupuis, Heather Macbeth
-/
import algebra.module.linear_map

/-!
# (Semi)linear equivalences

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

In this file we define

* `linear_equiv σ M M₂`, `M ≃ₛₗ[σ] M₂`: an invertible semilinear map. Here, `σ` is a `ring_hom`
  from `R` to `R₂` and an `e : M ≃ₛₗ[σ] M₂` satisfies `e (c • x) = (σ c) • (e x)`. The plain
  linear version, with `σ` being `ring_hom.id R`, is denoted by `M ≃ₗ[R] M₂`, and the
  star-linear version (with `σ` being `star_ring_end`) is denoted by `M ≃ₗ⋆[R] M₂`.

## Implementation notes

To ensure that composition works smoothly for semilinear equivalences, we use the typeclasses
`ring_hom_comp_triple`, `ring_hom_inv_pair` and `ring_hom_surjective` from
`algebra/ring/comp_typeclasses`.

The group structure on automorphisms, `linear_equiv.automorphism_group`, is provided elsewhere.

## TODO

* Parts of this file have not yet been generalized to semilinear maps

## Tags

linear equiv, linear equivalences, linear isomorphism, linear isomorphic
-/

open function

universes u u' v w x y z
variables {R : Type*} {R₁ : Type*} {R₂ : Type*} {R₃ : Type*}
variables {k : Type*} {S : Type*} {M : Type*} {M₁ : Type*} {M₂ : Type*} {M₃ : Type*}
variables {N₁ : Type*} {N₂ : Type*} {N₃ : Type*} {N₄ : Type*} {ι : Type*}

section
set_option old_structure_cmd true

/-- A linear equivalence is an invertible linear map. -/
@[nolint has_nonempty_instance]
structure linear_equiv {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R →+* S)
  {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
  (M : Type*) (M₂ : Type*)
  [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂]
  extends linear_map σ M M₂, M ≃+ M₂

attribute [nolint doc_blame] linear_equiv.to_linear_map
attribute [nolint doc_blame] linear_equiv.to_add_equiv

notation M ` ≃ₛₗ[`:50 σ `] ` M₂ := linear_equiv σ M M₂
notation M ` ≃ₗ[`:50 R `] ` M₂ := linear_equiv (ring_hom.id R) M M₂
notation M ` ≃ₗ⋆[`:50 R `] ` M₂ := linear_equiv (star_ring_end R) M M₂

/-- `semilinear_equiv_class F σ M M₂` asserts `F` is a type of bundled `σ`-semilinear equivs
`M → M₂`.

See also `linear_equiv_class F R M M₂` for the case where `σ` is the identity map on `R`.

A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S`
is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and
`f (c • x) = (σ c) • f x`. -/
class semilinear_equiv_class (F : Type*) {R S : out_param Type*} [semiring R] [semiring S]
  (σ : out_param $ R →+* S) {σ' : out_param $ S →+* R}
  [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] (M M₂ : out_param Type*)
  [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂]
  extends add_equiv_class F M M₂ :=
(map_smulₛₗ : ∀ (f : F) (r : R) (x : M), f (r • x) = (σ r) • f x)

-- `R, S, σ, σ'` become metavars, but it's OK since they are outparams.
attribute [nolint dangerous_instance] semilinear_equiv_class.to_add_equiv_class

/-- `linear_equiv_class F R M M₂` asserts `F` is a type of bundled `R`-linear equivs `M → M₂`.
This is an abbreviation for `semilinear_equiv_class F (ring_hom.id R) M M₂`.
-/
abbreviation linear_equiv_class (F : Type*) (R M M₂ : out_param Type*)
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂] :=
semilinear_equiv_class F (ring_hom.id R) M M₂

end

namespace semilinear_equiv_class

variables (F : Type*) [semiring R] [semiring S]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂]
variables [module R M] [module S M₂] {σ : R →+* S} {σ' : S →+* R}

-- `σ'` becomes a metavariable, but it's OK since it's an outparam
@[priority 100, nolint dangerous_instance]
instance [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] [s : semilinear_equiv_class F σ M M₂] :
  semilinear_map_class F σ M M₂ :=
{ coe := (coe : F → M → M₂),
  coe_injective' := @fun_like.coe_injective F _ _ _,
  ..s }

end semilinear_equiv_class

namespace linear_equiv

section add_comm_monoid

variables {M₄ : Type*}
variables [semiring R] [semiring S]

section
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂]
variables [module R M] [module S M₂] {σ : R →+* S} {σ' : S →+* R}
variables [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]

include R

include σ'
instance : has_coe (M ≃ₛₗ[σ] M₂) (M →ₛₗ[σ] M₂) := ⟨to_linear_map⟩
-- see Note [function coercion]
instance : has_coe_to_fun (M ≃ₛₗ[σ] M₂) (λ _, M → M₂) := ⟨to_fun⟩

@[simp] lemma coe_mk {to_fun inv_fun map_add map_smul left_inv right_inv } :
  ⇑(⟨to_fun, map_add, map_smul, inv_fun, left_inv, right_inv⟩ : M ≃ₛₗ[σ] M₂) = to_fun :=
rfl

-- This exists for compatibility, previously `≃ₗ[R]` extended `≃` instead of `≃+`.
@[nolint doc_blame]
def to_equiv : (M ≃ₛₗ[σ] M₂) → M ≃ M₂ := λ f, f.to_add_equiv.to_equiv

lemma to_equiv_injective : function.injective (to_equiv : (M ≃ₛₗ[σ] M₂) → M ≃ M₂) :=
λ ⟨_, _, _, _, _, _⟩ ⟨_, _, _, _, _, _⟩ h, linear_equiv.mk.inj_eq.mpr (equiv.mk.inj h)

@[simp] lemma to_equiv_inj {e₁ e₂ : M ≃ₛₗ[σ] M₂} : e₁.to_equiv = e₂.to_equiv ↔ e₁ = e₂ :=
to_equiv_injective.eq_iff

lemma to_linear_map_injective :
  injective (coe : (M ≃ₛₗ[σ] M₂) → (M →ₛₗ[σ] M₂)) :=
λ e₁ e₂ H, to_equiv_injective $ equiv.ext $ linear_map.congr_fun H

@[simp, norm_cast] lemma to_linear_map_inj {e₁ e₂ : M ≃ₛₗ[σ] M₂} :
  (e₁ : M →ₛₗ[σ] M₂) = e₂ ↔ e₁ = e₂ :=
to_linear_map_injective.eq_iff

instance : semilinear_equiv_class (M ≃ₛₗ[σ] M₂) σ M M₂ :=
{ coe := linear_equiv.to_fun,
  inv := linear_equiv.inv_fun,
  coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' },
  left_inv := linear_equiv.left_inv,
  right_inv := linear_equiv.right_inv,
  map_add := map_add',
  map_smulₛₗ := map_smul' }

lemma coe_injective :
  @injective (M ≃ₛₗ[σ] M₂) (M → M₂) coe_fn :=
fun_like.coe_injective

end

section
variables [semiring R₁] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂]
variables [add_comm_monoid M₃] [add_comm_monoid M₄]
variables [add_comm_monoid N₁] [add_comm_monoid N₂]
variables {module_M : module R M} {module_S_M₂ : module S M₂} {σ : R →+* S} {σ' : S →+* R}
variables {re₁ : ring_hom_inv_pair σ σ'} {re₂ : ring_hom_inv_pair σ' σ}
variables (e e' : M ≃ₛₗ[σ] M₂)

lemma to_linear_map_eq_coe : e.to_linear_map = (e : M →ₛₗ[σ] M₂) := rfl

@[simp, norm_cast] theorem coe_coe : ⇑(e : M →ₛₗ[σ] M₂) = e := rfl

@[simp] lemma coe_to_equiv : ⇑e.to_equiv = e := rfl

@[simp] lemma coe_to_linear_map : ⇑e.to_linear_map = e := rfl

@[simp] lemma to_fun_eq_coe : e.to_fun = e := rfl

section
variables {e e'}
@[ext] lemma ext (h : ∀ x, e x = e' x) : e = e' := fun_like.ext _ _ h

lemma ext_iff : e = e' ↔ ∀ x, e x = e' x := fun_like.ext_iff

protected lemma congr_arg {x x'} : x = x' → e x = e x' := fun_like.congr_arg e

protected lemma congr_fun (h : e = e') (x : M) : e x = e' x := fun_like.congr_fun h x

end

section
variables (M R)

/-- The identity map is a linear equivalence. -/
@[refl]
def refl [module R M] : M ≃ₗ[R] M := { .. linear_map.id, .. equiv.refl M }

end

@[simp] lemma refl_apply [module R M] (x : M) : refl R M x = x := rfl

include module_M module_S_M₂ re₁ re₂
/-- Linear equivalences are symmetric. -/
@[symm]
def symm (e : M ≃ₛₗ[σ] M₂) : M₂ ≃ₛₗ[σ'] M :=
{ to_fun := e.to_linear_map.inverse e.inv_fun e.left_inv e.right_inv,
  inv_fun := e.to_equiv.symm.inv_fun,
  map_smul' := λ r x, by rw map_smulₛₗ,
  .. e.to_linear_map.inverse e.inv_fun e.left_inv e.right_inv,
  .. e.to_equiv.symm }
omit module_M module_S_M₂ re₁ re₂

/-- See Note [custom simps projection] -/
def simps.symm_apply {R : Type*} {S : Type*} [semiring R] [semiring S] {σ : R →+* S}
  {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
  {M : Type*} {M₂ : Type*} [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂]
  (e : M ≃ₛₗ[σ] M₂) : M₂ → M := e.symm

initialize_simps_projections linear_equiv (to_fun → apply, inv_fun → symm_apply)

include σ'
@[simp] lemma inv_fun_eq_symm : e.inv_fun = e.symm := rfl
omit σ'

@[simp] lemma coe_to_equiv_symm : ⇑e.to_equiv.symm = e.symm := rfl

variables {module_M₁ : module R₁ M₁} {module_M₂ : module R₂ M₂} {module_M₃ : module R₃ M₃}
variables {module_N₁ : module R₁ N₁} {module_N₂ : module R₁ N₂}
variables {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃}
variables {σ₂₁ : R₂ →+* R₁} {σ₃₂ : R₃ →+* R₂} {σ₃₁ : R₃ →+* R₁}
variables [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃]
variables [ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁]
variables {re₁₂ : ring_hom_inv_pair σ₁₂ σ₂₁} {re₂₃ : ring_hom_inv_pair σ₂₃ σ₃₂}
variables [ring_hom_inv_pair σ₁₃ σ₃₁] {re₂₁ : ring_hom_inv_pair σ₂₁ σ₁₂}
variables {re₃₂ : ring_hom_inv_pair σ₃₂ σ₂₃} [ring_hom_inv_pair σ₃₁ σ₁₃]
variables (e₁₂ : M₁ ≃ₛₗ[σ₁₂] M₂) (e₂₃ : M₂ ≃ₛₗ[σ₂₃] M₃)

include σ₃₁
/-- Linear equivalences are transitive. -/
-- Note: the `ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁` is unused, but is convenient to carry around
-- implicitly for lemmas like `linear_equiv.self_trans_symm`.
@[trans, nolint unused_arguments]
def trans : M₁ ≃ₛₗ[σ₁₃] M₃ :=
{ .. e₂₃.to_linear_map.comp e₁₂.to_linear_map,
  .. e₁₂.to_equiv.trans e₂₃.to_equiv }
omit σ₃₁

infixl ` ≪≫ₗ `:80 := @linear_equiv.trans _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
  (ring_hom.id _) (ring_hom.id _) (ring_hom.id _)
  (ring_hom.id _) (ring_hom.id _) (ring_hom.id _)
  ring_hom_comp_triple.ids ring_hom_comp_triple.ids
  ring_hom_inv_pair.ids ring_hom_inv_pair.ids ring_hom_inv_pair.ids
  ring_hom_inv_pair.ids ring_hom_inv_pair.ids ring_hom_inv_pair.ids

variables {e₁₂} {e₂₃}

@[simp] lemma coe_to_add_equiv : ⇑(e.to_add_equiv) = e := rfl

/-- The two paths coercion can take to an `add_monoid_hom` are equivalent -/
lemma to_add_monoid_hom_commutes :
  e.to_linear_map.to_add_monoid_hom = e.to_add_equiv.to_add_monoid_hom :=
rfl

include σ₃₁
@[simp] theorem trans_apply (c : M₁) :
  (e₁₂.trans e₂₃ : M₁ ≃ₛₗ[σ₁₃] M₃) c = e₂₃ (e₁₂ c) := rfl

theorem coe_trans :
  (e₁₂.trans e₂₃ : M₁ →ₛₗ[σ₁₃] M₃) = (e₂₃ : M₂ →ₛₗ[σ₂₃] M₃).comp (e₁₂ : M₁ →ₛₗ[σ₁₂] M₂) := rfl
omit σ₃₁

include σ'
@[simp] theorem apply_symm_apply (c : M₂) : e (e.symm c) = c := e.right_inv c
@[simp] theorem symm_apply_apply (b : M) : e.symm (e b) = b := e.left_inv b
omit σ'

include σ₃₁ σ₂₁ σ₃₂
@[simp] lemma trans_symm : (e₁₂.trans e₂₃ : M₁ ≃ₛₗ[σ₁₃] M₃).symm = e₂₃.symm.trans e₁₂.symm :=
rfl

lemma symm_trans_apply
  (c : M₃) : (e₁₂.trans e₂₃ : M₁ ≃ₛₗ[σ₁₃] M₃).symm c = e₁₂.symm (e₂₃.symm c) := rfl
omit σ₃₁ σ₂₁ σ₃₂

@[simp] lemma trans_refl : e.trans (refl S M₂) = e := to_equiv_injective e.to_equiv.trans_refl
@[simp] lemma refl_trans : (refl R M).trans e = e := to_equiv_injective e.to_equiv.refl_trans

include σ'
lemma symm_apply_eq {x y} : e.symm x = y ↔ x = e y := e.to_equiv.symm_apply_eq

lemma eq_symm_apply {x y} : y = e.symm x ↔ e y = x := e.to_equiv.eq_symm_apply
omit σ'

lemma eq_comp_symm {α : Type*} (f : M₂ → α) (g : M₁ → α) :
  f = g ∘ e₁₂.symm ↔ f ∘ e₁₂ = g := e₁₂.to_equiv.eq_comp_symm f g

lemma comp_symm_eq {α : Type*} (f : M₂ → α) (g : M₁ → α) :
  g ∘ e₁₂.symm = f ↔ g = f ∘ e₁₂ := e₁₂.to_equiv.comp_symm_eq f g

lemma eq_symm_comp {α : Type*} (f : α → M₁) (g : α → M₂) :
  f = e₁₂.symm ∘ g ↔ e₁₂ ∘ f = g := e₁₂.to_equiv.eq_symm_comp f g

lemma symm_comp_eq {α : Type*} (f : α → M₁) (g : α → M₂) :
  e₁₂.symm ∘ g = f ↔ g = e₁₂ ∘ f := e₁₂.to_equiv.symm_comp_eq f g

variables [ring_hom_comp_triple σ₂₁ σ₁₃ σ₂₃] [ring_hom_comp_triple σ₃₁ σ₁₂ σ₃₂]

include module_M₃

lemma eq_comp_to_linear_map_symm (f : M₂ →ₛₗ[σ₂₃] M₃) (g : M₁ →ₛₗ[σ₁₃] M₃) :
  f = g.comp e₁₂.symm.to_linear_map ↔ f.comp e₁₂.to_linear_map = g :=
begin
  split; intro H; ext,
  { simp [H, e₁₂.to_equiv.eq_comp_symm f g] },
  { simp [←H, ←e₁₂.to_equiv.eq_comp_symm f g] }
end

lemma comp_to_linear_map_symm_eq (f : M₂ →ₛₗ[σ₂₃] M₃) (g : M₁ →ₛₗ[σ₁₃] M₃) :
  g.comp e₁₂.symm.to_linear_map = f ↔ g = f.comp e₁₂.to_linear_map :=
begin
  split; intro H; ext,
  { simp [←H, ←e₁₂.to_equiv.comp_symm_eq f g] },
  { simp [H, e₁₂.to_equiv.comp_symm_eq f g] }
end

lemma eq_to_linear_map_symm_comp (f : M₃ →ₛₗ[σ₃₁] M₁) (g : M₃ →ₛₗ[σ₃₂] M₂) :
  f = e₁₂.symm.to_linear_map.comp g ↔ e₁₂.to_linear_map.comp f = g :=
begin
  split; intro H; ext,
  { simp [H, e₁₂.to_equiv.eq_symm_comp f g] },
  { simp [←H, ←e₁₂.to_equiv.eq_symm_comp f g] }
end

lemma to_linear_map_symm_comp_eq (f : M₃ →ₛₗ[σ₃₁] M₁) (g : M₃ →ₛₗ[σ₃₂] M₂) :
  e₁₂.symm.to_linear_map.comp g = f ↔ g = e₁₂.to_linear_map.comp f :=
begin
  split; intro H; ext,
  { simp [←H, ←e₁₂.to_equiv.symm_comp_eq f g] },
  { simp [H, e₁₂.to_equiv.symm_comp_eq f g] }
end

omit module_M₃

@[simp] lemma refl_symm [module R M] : (refl R M).symm = linear_equiv.refl R M := rfl

include re₁₂ re₂₁ module_M₁ module_M₂
@[simp] lemma self_trans_symm (f : M₁ ≃ₛₗ[σ₁₂] M₂) :
  f.trans f.symm = linear_equiv.refl R₁ M₁ :=
by { ext x, simp }

@[simp] lemma symm_trans_self (f : M₁ ≃ₛₗ[σ₁₂] M₂) :
  f.symm.trans f = linear_equiv.refl R₂ M₂ :=
by { ext x, simp }
omit re₁₂ re₂₁ module_M₁ module_M₂

@[simp, norm_cast] lemma refl_to_linear_map [module R M] :
  (linear_equiv.refl R M : M →ₗ[R] M) = linear_map.id :=
rfl

@[simp, norm_cast]
lemma comp_coe [module R M] [module R M₂] [module R M₃] (f :  M ≃ₗ[R] M₂)
  (f' :  M₂ ≃ₗ[R] M₃) : (f' : M₂ →ₗ[R] M₃).comp (f : M →ₗ[R] M₂) = (f.trans f' : M ≃ₗ[R] M₃) :=
rfl

@[simp] lemma mk_coe (h₁ h₂ f h₃ h₄) :
  (linear_equiv.mk e h₁ h₂ f h₃ h₄ : M ≃ₛₗ[σ] M₂) = e := ext $ λ _, rfl

protected theorem map_add (a b : M) : e (a + b) = e a + e b := map_add e a b
protected theorem map_zero : e 0 = 0 := map_zero e
-- TODO: `simp` isn't picking up `map_smulₛₗ` for `linear_equiv`s without specifying `map_smulₛₗ f`
@[simp] protected theorem map_smulₛₗ (c : R) (x : M) : e (c • x) = (σ c) • e x := e.map_smul' c x

include module_N₁ module_N₂
theorem map_smul (e : N₁ ≃ₗ[R₁] N₂) (c : R₁) (x : N₁) :
  e (c • x) = c • e x := map_smulₛₗ e c x
omit module_N₁ module_N₂

@[simp] theorem map_eq_zero_iff {x : M} : e x = 0 ↔ x = 0 :=
e.to_add_equiv.map_eq_zero_iff
theorem map_ne_zero_iff {x : M} : e x ≠ 0 ↔ x ≠ 0 :=
e.to_add_equiv.map_ne_zero_iff

include module_M module_S_M₂ re₁ re₂
@[simp] theorem symm_symm (e : M ≃ₛₗ[σ] M₂): e.symm.symm = e :=
by { cases e, refl }
omit module_M module_S_M₂ re₁ re₂

lemma symm_bijective [module R M] [module S M₂] [ring_hom_inv_pair σ' σ]
  [ring_hom_inv_pair σ σ'] : function.bijective (symm : (M ≃ₛₗ[σ] M₂) → (M₂ ≃ₛₗ[σ'] M)) :=
equiv.bijective ⟨(symm : (M ≃ₛₗ[σ] M₂) →
  (M₂ ≃ₛₗ[σ'] M)), (symm : (M₂ ≃ₛₗ[σ'] M) → (M ≃ₛₗ[σ] M₂)), symm_symm, symm_symm⟩

@[simp] lemma mk_coe' (f h₁ h₂ h₃ h₄) : (linear_equiv.mk f h₁ h₂ ⇑e h₃ h₄ :
  M₂ ≃ₛₗ[σ'] M) = e.symm :=
symm_bijective.injective $ ext $ λ x, rfl

@[simp] theorem symm_mk (f h₁ h₂ h₃ h₄) :
  (⟨e, h₁, h₂, f, h₃, h₄⟩ : M ≃ₛₗ[σ] M₂).symm =
  { to_fun := f, inv_fun := e,
    ..(⟨e, h₁, h₂, f, h₃, h₄⟩ : M ≃ₛₗ[σ] M₂).symm } := rfl

@[simp] lemma coe_symm_mk [module R M] [module R M₂]
  {to_fun inv_fun map_add map_smul left_inv right_inv} :
  ⇑((⟨to_fun, map_add, map_smul, inv_fun, left_inv, right_inv⟩ : M ≃ₗ[R] M₂).symm) = inv_fun :=
rfl

protected lemma bijective : function.bijective e := e.to_equiv.bijective
protected lemma injective : function.injective e := e.to_equiv.injective
protected lemma surjective : function.surjective e := e.to_equiv.surjective

protected lemma image_eq_preimage (s : set M) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

protected lemma image_symm_eq_preimage (s : set M₂) : e.symm '' s = e ⁻¹' s :=
e.to_equiv.symm.image_eq_preimage s

end

/-- Interpret a `ring_equiv` `f` as an `f`-semilinear equiv. -/
@[simps]
def _root_.ring_equiv.to_semilinear_equiv (f : R ≃+* S) :
  by haveI := ring_hom_inv_pair.of_ring_equiv f;
     haveI := ring_hom_inv_pair.symm (↑f : R →+* S) (f.symm : S →+* R);
     exact (R ≃ₛₗ[(↑f : R →+* S)] S) :=
by exact
{ to_fun := f,
  map_smul' := f.map_mul,
  .. f}

variables [semiring R₁] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂]

/-- An involutive linear map is a linear equivalence. -/
def of_involutive {σ σ' : R →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
  {module_M : module R M} (f : M →ₛₗ[σ] M) (hf : involutive f) :
  M ≃ₛₗ[σ] M :=
{ .. f, .. hf.to_perm f }

@[simp] lemma coe_of_involutive {σ σ' : R →+* R} [ring_hom_inv_pair σ σ']
  [ring_hom_inv_pair σ' σ] {module_M : module R M} (f : M →ₛₗ[σ] M) (hf : involutive f) :
  ⇑(of_involutive f hf) = f :=
rfl

section restrict_scalars

variables (R) [module R M] [module R M₂] [module S M] [module S M₂]
  [linear_map.compatible_smul M M₂ R S]

/-- If `M` and `M₂` are both `R`-semimodules and `S`-semimodules and `R`-semimodule structures
are defined by an action of `R` on `S` (formally, we have two scalar towers), then any `S`-linear
equivalence from `M` to `M₂` is also an `R`-linear equivalence.

See also `linear_map.restrict_scalars`. -/
@[simps]
def restrict_scalars (f : M ≃ₗ[S] M₂) : M ≃ₗ[R] M₂ :=
{ to_fun := f,
  inv_fun := f.symm,
  left_inv := f.left_inv,
  right_inv := f.right_inv,
  .. f.to_linear_map.restrict_scalars R }

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (M ≃ₗ[S] M₂) → (M ≃ₗ[R] M₂)) :=
λ f g h, ext (linear_equiv.congr_fun h : _)

@[simp]
lemma restrict_scalars_inj (f g : M ≃ₗ[S] M₂) :
  f.restrict_scalars R = g.restrict_scalars R ↔ f = g :=
(restrict_scalars_injective R).eq_iff

end restrict_scalars

section automorphisms
variables [module R M]

instance automorphism_group : group (M ≃ₗ[R] M) :=
{ mul := λ f g, g.trans f,
  one := linear_equiv.refl R M,
  inv := λ f, f.symm,
  mul_assoc := λ f g h, rfl,
  mul_one := λ f, ext $ λ x, rfl,
  one_mul := λ f, ext $ λ x, rfl,
  mul_left_inv := λ f, ext $ f.left_inv }

/-- Restriction from `R`-linear automorphisms of `M` to `R`-linear endomorphisms of `M`,
promoted to a monoid hom. -/
@[simps]
def automorphism_group.to_linear_map_monoid_hom : (M ≃ₗ[R] M) →* (M →ₗ[R] M) :=
{ to_fun := coe,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

/-- The tautological action by `M ≃ₗ[R] M` on `M`.

This generalizes `function.End.apply_mul_action`. -/
instance apply_distrib_mul_action : distrib_mul_action (M ≃ₗ[R] M) M :=
{ smul := ($),
  smul_zero := linear_equiv.map_zero,
  smul_add := linear_equiv.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma smul_def (f : M ≃ₗ[R] M) (a : M) :
  f • a = f a := rfl

/-- `linear_equiv.apply_distrib_mul_action` is faithful. -/
instance apply_has_faithful_smul : has_faithful_smul (M ≃ₗ[R] M) M :=
⟨λ _ _, linear_equiv.ext⟩

instance apply_smul_comm_class : smul_comm_class R (M ≃ₗ[R] M) M :=
{ smul_comm := λ r e m, (e.map_smul r m).symm }

instance apply_smul_comm_class' : smul_comm_class (M ≃ₗ[R] M) R M :=
{ smul_comm := linear_equiv.map_smul }

end automorphisms

section of_subsingleton

variables (M M₂) [module R M] [module R M₂] [subsingleton M] [subsingleton M₂]

/-- Any two modules that are subsingletons are isomorphic. -/
@[simps] def of_subsingleton : M ≃ₗ[R] M₂ :=
{ to_fun := λ _, 0,
  inv_fun := λ _, 0,
  left_inv := λ x, subsingleton.elim _ _,
  right_inv := λ x, subsingleton.elim _ _,
  .. (0 : M →ₗ[R] M₂)}

@[simp] lemma of_subsingleton_self : of_subsingleton M M = refl R M :=
by { ext, simp }

end of_subsingleton

end add_comm_monoid

end linear_equiv

namespace module

/-- `g : R ≃+* S` is `R`-linear when the module structure on `S` is `module.comp_hom S g` . -/
@[simps]
def comp_hom.to_linear_equiv {R S : Type*} [semiring R] [semiring S] (g : R ≃+* S) :
  (by haveI := comp_hom S (↑g : R →+* S); exact (R ≃ₗ[R] S)) :=
by exact
{ to_fun := (g : R → S),
  inv_fun := (g.symm : S → R),
  map_smul' := g.map_mul,
  ..g }

end module

namespace distrib_mul_action

variables (R M) [semiring R] [add_comm_monoid M] [module R M]
variables [group S] [distrib_mul_action S M] [smul_comm_class S R M]

/-- Each element of the group defines a linear equivalence.

This is a stronger version of `distrib_mul_action.to_add_equiv`. -/
@[simps]
def to_linear_equiv (s : S) : M ≃ₗ[R] M :=
{ ..to_add_equiv M s,
  ..to_linear_map R M s }

/-- Each element of the group defines a module automorphism.

This is a stronger version of `distrib_mul_action.to_add_aut`. -/
@[simps]
def to_module_aut : S →* M ≃ₗ[R] M :=
{ to_fun := to_linear_equiv R M,
  map_one' := linear_equiv.ext $ one_smul _,
  map_mul' := λ a b, linear_equiv.ext $ mul_smul _ _ }

end distrib_mul_action

namespace add_equiv

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [module R M] [module R M₂]

variable (e : M ≃+ M₂)

/-- An additive equivalence whose underlying function preserves `smul` is a linear equivalence. -/
def to_linear_equiv (h : ∀ (c : R) x, e (c • x) = c • e x) : M ≃ₗ[R] M₂ :=
{ map_smul' := h, .. e, }

@[simp] lemma coe_to_linear_equiv (h : ∀ (c : R) x, e (c • x) = c • e x) :
  ⇑(e.to_linear_equiv h) = e :=
rfl

@[simp] lemma coe_to_linear_equiv_symm (h : ∀ (c : R) x, e (c • x) = c • e x) :
  ⇑(e.to_linear_equiv h).symm = e.symm :=
rfl

/-- An additive equivalence between commutative additive monoids is a linear equivalence between
ℕ-modules -/
def to_nat_linear_equiv  : M ≃ₗ[ℕ] M₂ :=
e.to_linear_equiv $ λ c a, by { erw e.to_add_monoid_hom.map_nsmul, refl }

@[simp] lemma coe_to_nat_linear_equiv :
  ⇑(e.to_nat_linear_equiv) = e := rfl

@[simp] lemma to_nat_linear_equiv_to_add_equiv :
  e.to_nat_linear_equiv.to_add_equiv = e := by { ext, refl }

@[simp] lemma _root_.linear_equiv.to_add_equiv_to_nat_linear_equiv
  (e : M ≃ₗ[ℕ] M₂) : e.to_add_equiv.to_nat_linear_equiv = e := fun_like.coe_injective rfl

@[simp] lemma to_nat_linear_equiv_symm :
  (e.to_nat_linear_equiv).symm = e.symm.to_nat_linear_equiv := rfl

@[simp] lemma to_nat_linear_equiv_refl :
  ((add_equiv.refl M).to_nat_linear_equiv) = linear_equiv.refl ℕ M := rfl

@[simp] lemma to_nat_linear_equiv_trans (e₂ : M₂ ≃+ M₃) :
  (e.to_nat_linear_equiv).trans (e₂.to_nat_linear_equiv) = (e.trans e₂).to_nat_linear_equiv := rfl

end add_comm_monoid

section add_comm_group

variables [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]

variable (e : M ≃+ M₂)

/-- An additive equivalence between commutative additive groups is a linear
equivalence between ℤ-modules -/
def to_int_linear_equiv : M ≃ₗ[ℤ] M₂ :=
e.to_linear_equiv $ λ c a, e.to_add_monoid_hom.map_zsmul a c

@[simp] lemma coe_to_int_linear_equiv :
  ⇑(e.to_int_linear_equiv) = e := rfl

@[simp] lemma to_int_linear_equiv_to_add_equiv :
  e.to_int_linear_equiv.to_add_equiv = e := by { ext, refl }

@[simp] lemma _root_.linear_equiv.to_add_equiv_to_int_linear_equiv
  (e : M ≃ₗ[ℤ] M₂) : e.to_add_equiv.to_int_linear_equiv = e := fun_like.coe_injective rfl

@[simp] lemma to_int_linear_equiv_symm :
  (e.to_int_linear_equiv).symm = e.symm.to_int_linear_equiv := rfl

@[simp] lemma to_int_linear_equiv_refl :
  ((add_equiv.refl M).to_int_linear_equiv) = linear_equiv.refl ℤ M := rfl

@[simp] lemma to_int_linear_equiv_trans (e₂ : M₂ ≃+ M₃)  :
  (e.to_int_linear_equiv).trans (e₂.to_int_linear_equiv) = (e.trans e₂).to_int_linear_equiv :=
rfl

end add_comm_group

end add_equiv


-- Principio de contraposición
-- ===========================

import tactic

variables  (P Q : Prop)

open_locale classical

-- ----------------------------------------------------
-- Ejercicio. Demostrar el principio de contraposición
--    (P → Q) ↔ (¬Q → ¬P)
-- ----------------------------------------------------

-- 1ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
begin
  split,
  { intros hPQ hnQ hP,
    apply hnQ,
    apply hPQ,
    exact hP,},
  { intros hQP hP,
    by_contradiction hnQ,
    apply absurd hP,
    apply hQP,
    exact hnQ, },
end

-- 2ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
begin
  split,
  { intros hPQ hnQ hP,
    exact hnQ (hPQ hP),},
  { intros hQP hP,
    by_contradiction hnQ,
    exact absurd hP (hQP hnQ), },
end

-- 3ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
begin
  split,
  { exact λ hPQ hnQ hP, hnQ (hPQ hP), },
  { exact λ hQP hP, by_contradiction (λ hnQ , absurd hP (hQP hnQ)), },
end

-- 4ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
⟨λ hPQ hnQ hP, hnQ (hPQ hP),
 λ hQP hP, by_contradiction (λ hnQ , absurd hP (hQP hnQ))⟩

-- 5ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
begin
  split,
  { intros h1 h2 h3,
    apply h2,
    exact h1 h3, },
  { intro h4,
    contrapose,
    exact h4, },
end

-- 6ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
iff.intro
  ( assume hPQ : P → Q,
    assume hnQ : ¬Q,
    assume hP : P,
    have hQ : Q,
      from hPQ hP,
    show false,
      from hnQ hQ )
  ( assume hQP : (¬Q → ¬P),
    assume hP : P,
    show Q, from
      by_contradiction
        ( assume hnQ : ¬Q,
          have hnP : ¬P,
            from hQP hnQ,
          show false,
            from hnP hP))

-- 7ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
iff.intro
  (λ hPQ hnQ hP, hnQ (hPQ hP))
  (λ hQP hP, by_contradiction (λ hnQ, (hQP hnQ) hP))

-- 8ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
-- by library_search
not_imp_not.symm

-- 9ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
-- by hint
by tauto

-- 10ª demostración
example :
  (P → Q) ↔ (¬Q → ¬P) :=
by finish


/-
Copyright (c) 2019 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.basic
import data.nat.choose.basic

/-! # sublists

`list.sublists` gives a list of all (not necessarily contiguous) sublists of a list.

This file contains basic results on this function.
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}
open nat

namespace list

/-! ### sublists -/

@[simp] theorem sublists'_nil : sublists' (@nil α) = [[]] := rfl

@[simp, priority 1100] theorem sublists'_singleton (a : α) : sublists' [a] = [[], [a]] := rfl

theorem map_sublists'_aux (g : list β → list γ) (l : list α) (f r) :
  map g (sublists'_aux l f r) = sublists'_aux l (g ∘ f) (map g r) :=
by induction l generalizing f r; [refl, simp only [*, sublists'_aux]]

theorem sublists'_aux_append (r' : list (list β)) (l : list α) (f r) :
  sublists'_aux l f (r ++ r') = sublists'_aux l f r ++ r' :=
by induction l generalizing f r; [refl, simp only [*, sublists'_aux]]

theorem sublists'_aux_eq_sublists' (l f r) :
  @sublists'_aux α β l f r = map f (sublists' l) ++ r :=
by rw [sublists', map_sublists'_aux, ← sublists'_aux_append]; refl

@[simp] theorem sublists'_cons (a : α) (l : list α) :
  sublists' (a :: l) = sublists' l ++ map (cons a) (sublists' l) :=
by rw [sublists', sublists'_aux]; simp only [sublists'_aux_eq_sublists', map_id, append_nil]; refl

@[simp] theorem mem_sublists' {s t : list α} : s ∈ sublists' t ↔ s <+ t :=
begin
  induction t with a t IH generalizing s,
  { simp only [sublists'_nil, mem_singleton],
    exact ⟨λ h, by rw h, eq_nil_of_sublist_nil⟩ },
  simp only [sublists'_cons, mem_append, IH, mem_map],
  split; intro h, rcases h with h | ⟨s, h, rfl⟩,
  { exact sublist_cons_of_sublist _ h },
  { exact h.cons_cons _ },
  { cases h with _ _ _ h s _ _ h,
    { exact or.inl h },
    { exact or.inr ⟨s, h, rfl⟩ } }
end

@[simp] theorem length_sublists' : ∀ l : list α, length (sublists' l) = 2 ^ length l
| []     := rfl
| (a::l) := by simp only [sublists'_cons, length_append, length_sublists' l, length_map,
    length, pow_succ', mul_succ, mul_zero, zero_add]

@[simp] theorem sublists_nil : sublists (@nil α) = [[]] := rfl

@[simp] theorem sublists_singleton (a : α) : sublists [a] = [[], [a]] := rfl

theorem sublists_aux₁_eq_sublists_aux : ∀ l (f : list α → list β),
  sublists_aux₁ l f = sublists_aux l (λ ys r, f ys ++ r)
| []     f := rfl
| (a::l) f := by rw [sublists_aux₁, sublists_aux]; simp only [*, append_assoc]

theorem sublists_aux_cons_eq_sublists_aux₁ (l : list α) :
  sublists_aux l cons = sublists_aux₁ l (λ x, [x]) :=
by rw [sublists_aux₁_eq_sublists_aux]; refl

theorem sublists_aux_eq_foldr.aux {a : α} {l : list α}
  (IH₁ : ∀ (f : list α → list β → list β), sublists_aux l f = foldr f [] (sublists_aux l cons))
  (IH₂ : ∀ (f : list α → list (list α) → list (list α)),
      sublists_aux l f = foldr f [] (sublists_aux l cons))
  (f : list α → list β → list β) : sublists_aux (a::l) f = foldr f [] (sublists_aux (a::l) cons) :=
begin
  simp only [sublists_aux, foldr_cons], rw [IH₂, IH₁], congr' 1,
  induction sublists_aux l cons with _ _ ih, {refl},
  simp only [ih, foldr_cons]
end

theorem sublists_aux_eq_foldr (l : list α) : ∀ (f : list α → list β → list β),
  sublists_aux l f = foldr f [] (sublists_aux l cons) :=
suffices _ ∧ ∀ f : list α → list (list α) → list (list α),
    sublists_aux l f = foldr f [] (sublists_aux l cons),
  from this.1,
begin
  induction l with a l IH, {split; intro; refl},
  exact ⟨sublists_aux_eq_foldr.aux IH.1 IH.2,
         sublists_aux_eq_foldr.aux IH.2 IH.2⟩
end

theorem sublists_aux_cons_cons (l : list α) (a : α) :
  sublists_aux (a::l) cons = [a] :: foldr (λys r, ys :: (a :: ys) :: r) [] (sublists_aux l cons) :=
by rw [← sublists_aux_eq_foldr]; refl

theorem sublists_aux₁_append : ∀ (l₁ l₂ : list α) (f : list α → list β),
  sublists_aux₁ (l₁ ++ l₂) f = sublists_aux₁ l₁ f ++
    sublists_aux₁ l₂ (λ x, f x ++ sublists_aux₁ l₁ (f ∘ (++ x)))
| []      l₂ f := by simp only [sublists_aux₁, nil_append, append_nil]
| (a::l₁) l₂ f := by simp only [sublists_aux₁, cons_append, sublists_aux₁_append l₁, append_assoc];
  refl

theorem sublists_aux₁_concat (l : list α) (a : α) (f : list α → list β) :
  sublists_aux₁ (l ++ [a]) f = sublists_aux₁ l f ++
    f [a] ++ sublists_aux₁ l (λ x, f (x ++ [a])) :=
by simp only [sublists_aux₁_append, sublists_aux₁, append_assoc, append_nil]

theorem sublists_aux₁_bind : ∀ (l : list α)
  (f : list α → list β) (g : β → list γ),
  (sublists_aux₁ l f).bind g = sublists_aux₁ l (λ x, (f x).bind g)
| []     f g := rfl
| (a::l) f g := by simp only [sublists_aux₁, bind_append, sublists_aux₁_bind l]

theorem sublists_aux_cons_append (l₁ l₂ : list α) :
  sublists_aux (l₁ ++ l₂) cons = sublists_aux l₁ cons ++
    (do x ← sublists_aux l₂ cons, (++ x) <$> sublists l₁) :=
begin
  simp only [sublists, sublists_aux_cons_eq_sublists_aux₁, sublists_aux₁_append, bind_eq_bind,
    sublists_aux₁_bind],
  congr, funext x, apply congr_arg _,
  rw [← bind_ret_eq_map, sublists_aux₁_bind], exact (append_nil _).symm
end

theorem sublists_append (l₁ l₂ : list α) :
  sublists (l₁ ++ l₂) = (do x ← sublists l₂, (++ x) <$> sublists l₁) :=
by simp only [map, sublists, sublists_aux_cons_append, map_eq_map, bind_eq_bind,
  cons_bind, map_id', append_nil, cons_append, map_id' (λ _, rfl)]; split; refl

@[simp] theorem sublists_concat (l : list α) (a : α) :
  sublists (l ++ [a]) = sublists l ++ map (λ x, x ++ [a]) (sublists l) :=
by rw [sublists_append, sublists_singleton, bind_eq_bind, cons_bind, cons_bind, nil_bind,
  map_eq_map, map_eq_map, map_id' (append_nil), append_nil]

theorem sublists_reverse (l : list α) : sublists (reverse l) = map reverse (sublists' l) :=
by induction l with hd tl ih; [refl,
simp only [reverse_cons, sublists_append, sublists'_cons, map_append, ih, sublists_singleton,
  map_eq_map, bind_eq_bind, map_map, cons_bind, append_nil, nil_bind, (∘)]]

theorem sublists_eq_sublists' (l : list α) : sublists l = map reverse (sublists' (reverse l)) :=
by rw [← sublists_reverse, reverse_reverse]

theorem sublists'_reverse (l : list α) : sublists' (reverse l) = map reverse (sublists l) :=
by simp only [sublists_eq_sublists', map_map, map_id' (reverse_reverse)]

theorem sublists'_eq_sublists (l : list α) : sublists' l = map reverse (sublists (reverse l)) :=
by rw [← sublists'_reverse, reverse_reverse]

theorem sublists_aux_ne_nil : ∀ (l : list α), [] ∉ sublists_aux l cons
| [] := id
| (a::l) := begin
  rw [sublists_aux_cons_cons],
  refine not_mem_cons_of_ne_of_not_mem (cons_ne_nil _ _).symm _,
  have := sublists_aux_ne_nil l, revert this,
  induction sublists_aux l cons; intro, {rwa foldr},
  simp only [foldr, mem_cons_iff, false_or, not_or_distrib],
  exact ⟨ne_of_not_mem_cons this, ih (not_mem_of_not_mem_cons this)⟩
end

@[simp] theorem mem_sublists {s t : list α} : s ∈ sublists t ↔ s <+ t :=
by rw [← reverse_sublist_iff, ← mem_sublists',
       sublists'_reverse, mem_map_of_injective reverse_injective]

@[simp] theorem length_sublists (l : list α) : length (sublists l) = 2 ^ length l :=
by simp only [sublists_eq_sublists', length_map, length_sublists', length_reverse]

theorem map_ret_sublist_sublists (l : list α) : map list.ret l <+ sublists l :=
reverse_rec_on l (nil_sublist _) $
λ l a IH, by simp only [map, map_append, sublists_concat]; exact
((append_sublist_append_left _).2 $ singleton_sublist.2 $
  mem_map.2 ⟨[], mem_sublists.2 (nil_sublist _), by refl⟩).trans
((append_sublist_append_right _).2 IH)

/-! ### sublists_len -/

/-- Auxiliary function to construct the list of all sublists of a given length. Given an
integer `n`, a list `l`, a function `f` and an auxiliary list `L`, it returns the list made of
of `f` applied to all sublists of `l` of length `n`, concatenated with `L`. -/
def sublists_len_aux {α β : Type*} : ℕ → list α → (list α → β) → list β → list β
| 0     l      f r := f [] :: r
| (n+1) []     f r := r
| (n+1) (a::l) f r := sublists_len_aux (n + 1) l f
  (sublists_len_aux n l (f ∘ list.cons a) r)

/-- The list of all sublists of a list `l` that are of length `n`. For instance, for
`l = [0, 1, 2, 3]` and `n = 2`, one gets
`[[2, 3], [1, 3], [1, 2], [0, 3], [0, 2], [0, 1]]`. -/
def sublists_len {α : Type*} (n : ℕ) (l : list α) : list (list α) :=
sublists_len_aux n l id []

lemma sublists_len_aux_append {α β γ : Type*} :
  ∀ (n : ℕ) (l : list α) (f : list α → β) (g : β → γ) (r : list β) (s : list γ),
  sublists_len_aux n l (g ∘ f) (r.map g ++ s) =
  (sublists_len_aux n l f r).map g ++ s
| 0     l      f g r s := rfl
| (n+1) []     f g r s := rfl
| (n+1) (a::l) f g r s := begin
  unfold sublists_len_aux,
  rw [show ((g ∘ f) ∘ list.cons a) = (g ∘ f ∘ list.cons a), by refl,
    sublists_len_aux_append, sublists_len_aux_append]
end

lemma sublists_len_aux_eq {α β : Type*} (l : list α) (n) (f : list α → β) (r) :
  sublists_len_aux n l f r = (sublists_len n l).map f ++ r :=
by rw [sublists_len, ← sublists_len_aux_append]; refl

lemma sublists_len_aux_zero {α : Type*} (l : list α) (f : list α → β) (r) :
  sublists_len_aux 0 l f r = f [] :: r := by cases l; refl

@[simp]

@[simp] lemma sublists_len_succ_nil {α : Type*} (n) :
  sublists_len (n+1) (@nil α) = [] := rfl

@[simp] lemma sublists_len_succ_cons {α : Type*} (n) (a : α) (l) :
  sublists_len (n + 1) (a::l) =
  sublists_len (n + 1) l ++ (sublists_len n l).map (cons a) :=
by rw [sublists_len, sublists_len_aux, sublists_len_aux_eq,
  sublists_len_aux_eq, map_id, append_nil]; refl

@[simp] lemma length_sublists_len {α : Type*} : ∀ n (l : list α),
  length (sublists_len n l) = nat.choose (length l) n
| 0     l      := by simp
| (n+1) []     := by simp
| (n+1) (a::l) := by simp [-add_comm, nat.choose, *]; apply add_comm

lemma sublists_len_sublist_sublists' {α : Type*} : ∀ n (l : list α),
  sublists_len n l <+ sublists' l
| 0     l      := singleton_sublist.2 (mem_sublists'.2 (nil_sublist _))
| (n+1) []     := nil_sublist _
| (n+1) (a::l) := begin
  rw [sublists_len_succ_cons, sublists'_cons],
  exact (sublists_len_sublist_sublists' _ _).append
    ((sublists_len_sublist_sublists' _ _).map _)
end

lemma sublists_len_sublist_of_sublist
  {α : Type*} (n) {l₁ l₂ : list α} (h : l₁ <+ l₂) : sublists_len n l₁ <+ sublists_len n l₂ :=
begin
  induction n with n IHn generalizing l₁ l₂, {simp},
  induction h with l₁ l₂ a s IH l₁ l₂ a s IH, {refl},
  { refine IH.trans _,
    rw sublists_len_succ_cons,
    apply sublist_append_left },
  { simp [sublists_len_succ_cons],
    exact IH.append ((IHn s).map _) }
end

lemma length_of_sublists_len {α : Type*} : ∀ {n} {l l' : list α},
  l' ∈ sublists_len n l → length l' = n
| 0     l      l' (or.inl rfl) := rfl
| (n+1) (a::l) l' h := begin
  rw [sublists_len_succ_cons, mem_append, mem_map] at h,
  rcases h with h | ⟨l', h, rfl⟩,
  { exact length_of_sublists_len h },
  { exact congr_arg (+1) (length_of_sublists_len h) },
end

lemma mem_sublists_len_self {α : Type*} {l l' : list α}
  (h : l' <+ l) : l' ∈ sublists_len (length l') l :=
begin
  induction h with l₁ l₂ a s IH l₁ l₂ a s IH,
  { exact or.inl rfl },
  { cases l₁ with b l₁,
    { exact or.inl rfl },
    { rw [length, sublists_len_succ_cons],
      exact mem_append_left _ IH } },
  { rw [length, sublists_len_succ_cons],
    exact mem_append_right _ (mem_map.2 ⟨_, IH, rfl⟩) }
end

@[simp] lemma mem_sublists_len {α : Type*} {n} {l l' : list α} :
  l' ∈ sublists_len n l ↔ l' <+ l ∧ length l' = n :=
⟨λ h, ⟨mem_sublists'.1
    ((sublists_len_sublist_sublists' _ _).subset h),
  length_of_sublists_len h⟩,
λ ⟨h₁, h₂⟩, h₂ ▸ mem_sublists_len_self h₁⟩

end list