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

import group_theory.perm.sign
import group_theory.perm.subgroup
import group_theory.quotient_group
import linear_algebra.linear_independent
import linear_algebra.multilinear.basis
import linear_algebra.multilinear.tensor_product
import logic.equiv.fin

/-!
# Alternating Maps

We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
arguments of the same type.

## Main definitions
* `alternating_map R M N ι` is the space of `R`-linear alternating maps from `ι → M` to `N`.
* `f.map_eq_zero_of_eq` expresses that `f` is zero when two inputs are equal.
* `f.map_swap` expresses that `f` is negated when two inputs are swapped.
* `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
* An `add_comm_monoid`, `add_comm_group`, and `module` structure over `alternating_map`s that
  matches the definitions over `multilinear_map`s.
* `multilinear_map.dom_dom_congr`, for permutating the elements within a family.
* `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.
* `alternating_map.dom_coprod`, which behaves as a product between two alternating maps.
* `alternating_map.curry_left`, for binding the leftmost argument of an alternating map indexed
  by `fin n.succ`.

## Implementation notes
`alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
using `map_swap` as a definition, and does not require `has_neg N`.

`alternating_map`s are provided with a coercion to `multilinear_map`, along with a set of
`norm_cast` lemmas that act on the algebraic structure:

* `alternating_map.coe_add`
* `alternating_map.coe_zero`
* `alternating_map.coe_sub`
* `alternating_map.coe_neg`
* `alternating_map.coe_smul`
-/

-- semiring / add_comm_monoid
variables {R : Type*} [semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]

-- semiring / add_comm_group
variables {M' : Type*} [add_comm_group M'] [module R M']
variables {N' : Type*} [add_comm_group N'] [module R N']

variables {ι ι' ι'' : Type*} [decidable_eq ι] [decidable_eq ι'] [decidable_eq ι'']

set_option old_structure_cmd true

section
variables (R M N ι)
/--
An alternating map is a multilinear map that vanishes when two of its arguments are equal.
-/
structure alternating_map extends multilinear_map R (λ i : ι, M) N :=
(map_eq_zero_of_eq' : ∀ (v : ι → M) (i j : ι) (h : v i = v j) (hij : i ≠ j), to_fun v = 0)
end

/-- The multilinear map associated to an alternating map -/
add_decl_doc alternating_map.to_multilinear_map

namespace alternating_map

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/
section coercions

instance : has_coe_to_fun (alternating_map R M N ι) (λ _, (ι → M) → N) := ⟨λ x, x.to_fun⟩

initialize_simps_projections alternating_map (to_fun → apply)

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

@[simp] lemma coe_mk (f : (ι → M) → N) (h₁ h₂ h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ :
  alternating_map R M N ι) = f := rfl

theorem congr_fun {f g : alternating_map R M N ι} (h : f = g) (x : ι → M) : f x = g x :=
congr_arg (λ h : alternating_map R M N ι, h x) h

theorem congr_arg (f : alternating_map R M N ι) {x y : ι → M} (h : x = y) : f x = f y :=
congr_arg (λ x : ι → M, f x) h

theorem coe_injective : injective (coe_fn : alternating_map R M N ι → ((ι → M) → N)) :=
λ f g h, by { cases f, cases g, cases h, refl }

@[simp, norm_cast] theorem coe_inj {f g : alternating_map R M N ι} :
  (f : (ι → M) → N) = g ↔ f = g :=
coe_injective.eq_iff

@[ext] theorem ext {f f' : alternating_map R M N ι} (H : ∀ x, f x = f' x) : f = f' :=
coe_injective (funext H)

theorem ext_iff {f g : alternating_map R M N ι} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

instance : has_coe (alternating_map R M N ι) (multilinear_map R (λ i : ι, M) N) :=
⟨λ x, x.to_multilinear_map⟩

@[simp, norm_cast] lemma coe_multilinear_map : ⇑(f : multilinear_map R (λ i : ι, M) N) = f := rfl

lemma coe_multilinear_map_injective :
  function.injective (coe : alternating_map R M N ι → multilinear_map R (λ i : ι, M) N) :=
λ x y h, ext $ multilinear_map.congr_fun h

@[simp] lemma to_multilinear_map_eq_coe : f.to_multilinear_map = f := rfl

@[simp] lemma coe_multilinear_map_mk (f : (ι → M) → N) (h₁ h₂ h₃) :
  ((⟨f, h₁, h₂, h₃⟩ : alternating_map R M N ι) :  multilinear_map R (λ i : ι, M) N) = ⟨f, h₁, h₂⟩ :=
rfl

end coercions

/-!
### Simp-normal forms of the structure fields

These are expressed in terms of `⇑f` instead of `f.to_fun`.
-/
@[simp] lemma map_add (i : ι) (x y : M) :
  f (update v i (x + y)) = f (update v i x) + f (update v i y) :=
f.to_multilinear_map.map_add' v i x y

@[simp] lemma map_sub (i : ι) (x y : M') :
  g' (update v' i (x - y)) = g' (update v' i x) - g' (update v' i y) :=
g'.to_multilinear_map.map_sub v' i x y

@[simp] lemma map_neg (i : ι) (x : M') :
  g' (update v' i (-x)) = -g' (update v' i x) :=
g'.to_multilinear_map.map_neg v' i x

@[simp] lemma map_smul (i : ι) (r : R) (x : M) :
  f (update v i (r • x)) = r • f (update v i x) :=
f.to_multilinear_map.map_smul' v i r x

@[simp] lemma map_eq_zero_of_eq (v : ι → M) {i j : ι} (h : v i = v j) (hij : i ≠ j) :
  f v = 0 :=
f.map_eq_zero_of_eq' v i j h hij

@[simp] lemma map_update_zero (m : ι → M) (i : ι) : f (update m i 0) = 0 :=
f.to_multilinear_map.map_update_zero m i

@[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
f.to_multilinear_map.map_zero

lemma map_eq_zero_of_not_injective (v : ι → M) (hv : ¬function.injective v) : f v = 0 :=
begin
  rw function.injective at hv,
  push_neg at hv,
  rcases hv with ⟨i₁, i₂, heq, hne⟩,
  exact f.map_eq_zero_of_eq v heq hne
end

/-!
### Algebraic structure inherited from `multilinear_map`

`alternating_map` carries the same `add_comm_monoid`, `add_comm_group`, and `module` structure
as `multilinear_map`
-/

section has_scalar

variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]

instance : has_scalar S (alternating_map R M N ι) :=
⟨λ c f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..((c • f : multilinear_map R (λ i : ι, M) N)) }⟩

@[simp] lemma smul_apply (c : S) (m : ι → M) :
  (c • f) m = c • f m := rfl

@[norm_cast] lemma coe_smul (c : S):
  ((c • f : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = c • f := rfl

lemma coe_fn_smul (c : S) (f : alternating_map R M N ι) : ⇑(c • f) = c • f :=
rfl

end has_scalar

instance : has_add (alternating_map R M N ι) :=
⟨λ a b,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [a.map_eq_zero_of_eq v h hij, b.map_eq_zero_of_eq v h hij],
    ..(a + b : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma add_apply : (f + f') v = f v + f' v := rfl

@[norm_cast] lemma coe_add : (↑(f  + f') : multilinear_map R (λ i : ι, M) N) = f + f' := rfl

instance : has_zero (alternating_map R M N ι) :=
⟨{map_eq_zero_of_eq' := λ v i j h hij, by simp,
  ..(0 : multilinear_map R (λ i : ι, M) N)}⟩

@[simp] lemma zero_apply : (0 : alternating_map R M N ι) v = 0 := rfl

@[norm_cast] lemma coe_zero :
  ((0 : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N) = 0 := rfl

instance : inhabited (alternating_map R M N ι) := ⟨0⟩

instance : add_comm_monoid (alternating_map R M N ι) :=
coe_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, coe_fn_smul _ _)

instance : has_neg (alternating_map R M N' ι) :=
⟨λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
    ..(-(f : multilinear_map R (λ i : ι, M) N')) }⟩

@[simp] lemma neg_apply (m : ι → M) : (-g) m = -(g m) := rfl

@[norm_cast] lemma coe_neg :
  ((-g : alternating_map R M N' ι) : multilinear_map R (λ i : ι, M) N') = -g := rfl

instance : has_sub (alternating_map R M N' ι) :=
⟨λ f g,
  { map_eq_zero_of_eq' :=
      λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij, g.map_eq_zero_of_eq v h hij],
    ..(f - g : multilinear_map R (λ i : ι, M) N') }⟩

@[simp] lemma sub_apply (m : ι → M) : (g - g₂) m = g m - g₂ m := rfl

@[norm_cast] lemma coe_sub : (↑(g - g₂) : multilinear_map R (λ i : ι, M) N') = g - g₂ := rfl

instance : add_comm_group (alternating_map R M N' ι) :=
coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ _ _, coe_fn_smul _ _) (λ _ _, coe_fn_smul _ _)

section distrib_mul_action

variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]

instance : distrib_mul_action S (alternating_map R M N ι) :=
{ one_smul := λ f, ext $ λ x, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
  smul_zero := λ r, ext $ λ x, smul_zero _,
  smul_add := λ r f₁ f₂, ext $ λ x, smul_add _ _ _ }

end distrib_mul_action

section module

variables {S : Type*} [semiring S] [module S N] [smul_comm_class R S N]

/-- The space of multilinear maps over an algebra over `R` is a module over `R`, for the pointwise
addition and scalar multiplication. -/
instance : module S (alternating_map R M N ι) :=
{ add_smul := λ r₁ r₂ f, ext $ λ x, add_smul _ _ _,
  zero_smul := λ f, ext $ λ x, zero_smul _ _ }

instance [no_zero_smul_divisors S N] : no_zero_smul_divisors S (alternating_map R M N ι) :=
coe_injective.no_zero_smul_divisors _ rfl coe_fn_smul

end module

section
variables (R M)

/-- The evaluation map from `ι → M` to `M` at a given `i` is alternating when `ι` is subsingleton.
-/
@[simps]
def of_subsingleton [subsingleton ι] (i : ι) : alternating_map R M M ι :=
{ to_fun := function.eval i,
  map_eq_zero_of_eq' := λ v i j hv hij, (hij $ subsingleton.elim _ _).elim,
  ..multilinear_map.of_subsingleton R M i }

/-- The constant map is alternating when `ι` is empty. -/
@[simps {fully_applied := ff}]
def const_of_is_empty [is_empty ι] (m : N) : alternating_map R M N ι :=
{ to_fun := function.const _ m,
  map_eq_zero_of_eq' := λ v, is_empty_elim,
  ..multilinear_map.const_of_is_empty R m }

end

/-- Restrict the codomain of an alternating map to a submodule. -/
@[simps]
def cod_restrict (f : alternating_map R M N ι) (p : submodule R N) (h : ∀ v, f v ∈ p) :
  alternating_map R M p ι :=
{ to_fun := λ v, ⟨f v, h v⟩,
  map_eq_zero_of_eq' := λ v i j hv hij, subtype.ext $ map_eq_zero_of_eq _ _ hv hij,
  ..f.to_multilinear_map.cod_restrict p h }

end alternating_map

/-!
### Composition with linear maps
-/

namespace linear_map

variables {N₂ : Type*} [add_comm_monoid N₂] [module R N₂]

/-- Composing a alternating map with a linear map on the left gives again an alternating map. -/
def comp_alternating_map (g : N →ₗ[R] N₂) : alternating_map R M N ι →+ alternating_map R M N₂ ι :=
{ to_fun := λ f,
  { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
              ..(g.comp_multilinear_map (f : multilinear_map R (λ _ : ι, M) N)) },
  map_zero' := by { ext, simp },
  map_add' := λ a b, by { ext, simp } }

@[simp] lemma coe_comp_alternating_map (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) :
  ⇑(g.comp_alternating_map f) = g ∘ f := rfl

@[simp]
lemma comp_alternating_map_apply (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) (m : ι → M) :
  g.comp_alternating_map f m = g (f m) := rfl

@[simp]
lemma subtype_comp_alternating_map_cod_restrict (f : alternating_map R M N ι) (p : submodule R N)
  (h) :
  p.subtype.comp_alternating_map (f.cod_restrict p h) = f :=
alternating_map.ext $ λ v, rfl

@[simp]
lemma comp_alternating_map_cod_restrict (g : N →ₗ[R] N₂) (f : alternating_map R M N ι)
  (p : submodule R N₂) (h) :
  (g.cod_restrict p h).comp_alternating_map f =
    (g.comp_alternating_map f).cod_restrict p (λ v, h (f v)):=
alternating_map.ext $ λ v, rfl

end linear_map

namespace alternating_map

variables {M₂ : Type*} [add_comm_monoid M₂] [module R M₂]
variables {M₃ : Type*} [add_comm_monoid M₃] [module R M₃]

/-- Composing a alternating map with the same linear map on each argument gives again an
alternating map. -/
def comp_linear_map (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) : alternating_map R M₂ N ι :=
{ map_eq_zero_of_eq' := λ v i j h hij, f.map_eq_zero_of_eq _ (linear_map.congr_arg h) hij,
  .. (f : multilinear_map R (λ _ : ι, M) N).comp_linear_map (λ _, g) }

lemma coe_comp_linear_map (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) :
  ⇑(f.comp_linear_map g) = f ∘ ((∘) g) := rfl

@[simp] lemma comp_linear_map_apply (f : alternating_map R M N ι) (g : M₂ →ₗ[R] M) (v : ι → M₂) :
  f.comp_linear_map g v = f (λ i, g (v i)) := rfl

/-- Composing an alternating map twice with the same linear map in each argument is
the same as composing with their composition. -/
lemma comp_linear_map_assoc (f : alternating_map R M N ι) (g₁ : M₂ →ₗ[R] M) (g₂ : M₃ →ₗ[R] M₂) :
  (f.comp_linear_map g₁).comp_linear_map g₂ = f.comp_linear_map (g₁ ∘ₗ g₂) :=
rfl

@[simp] lemma zero_comp_linear_map (g : M₂ →ₗ[R] M) :
  (0 : alternating_map R M N ι).comp_linear_map g = 0 :=
by { ext, simp only [comp_linear_map_apply, zero_apply] }

@[simp] lemma add_comp_linear_map (f₁ f₂ : alternating_map R M N ι) (g : M₂ →ₗ[R] M) :
  (f₁ + f₂).comp_linear_map g = f₁.comp_linear_map g + f₂.comp_linear_map g :=
by { ext, simp only [comp_linear_map_apply, add_apply] }

@[simp] lemma comp_linear_map_zero [nonempty ι] (f : alternating_map R M N ι) :
  f.comp_linear_map (0 : M₂ →ₗ[R] M) = 0 :=
begin
  ext,
  simp_rw [comp_linear_map_apply, linear_map.zero_apply, ←pi.zero_def, map_zero, zero_apply],
end

/-- Composing an alternating map with the identity linear map in each argument. -/
@[simp] lemma comp_linear_map_id (f : alternating_map R M N ι) :
  f.comp_linear_map linear_map.id = f :=
ext $ λ _, rfl

/-- Composing with a surjective linear map is injective. -/
lemma comp_linear_map_injective (f : M₂ →ₗ[R] M) (hf : function.surjective f) :
  function.injective (λ g : alternating_map R M N ι, g.comp_linear_map f) :=
λ g₁ g₂ h, ext $ λ x,
by simpa [function.surj_inv_eq hf] using ext_iff.mp h (function.surj_inv hf ∘ x)

lemma comp_linear_map_inj (f : M₂ →ₗ[R] M) (hf : function.surjective f)
  (g₁ g₂ : alternating_map R M N ι) : g₁.comp_linear_map f = g₂.comp_linear_map f ↔ g₁ = g₂ :=
(comp_linear_map_injective _ hf).eq_iff

section dom_lcongr

variables (ι R N) (S : Type*) [semiring S] [module S N] [smul_comm_class R S N]

/-- Construct a linear equivalence between maps from a linear equivalence between domains. -/
@[simps apply]
def dom_lcongr (e : M ≃ₗ[R] M₂) : alternating_map R M N ι ≃ₗ[S] alternating_map R M₂ N ι :=
{ to_fun := λ f, f.comp_linear_map e.symm,
  inv_fun := λ g, g.comp_linear_map e,
  map_add' := λ _ _, rfl,
  map_smul' := λ _ _, rfl,
  left_inv := λ f, alternating_map.ext $ λ v, f.congr_arg $ funext $ λ i, e.symm_apply_apply _,
  right_inv := λ f, alternating_map.ext $ λ v, f.congr_arg $ funext $ λ i, e.apply_symm_apply _ }

@[simp] lemma dom_lcongr_refl :
  dom_lcongr R N ι S (linear_equiv.refl R M) = linear_equiv.refl S _ :=
linear_equiv.ext $ λ _, alternating_map.ext $ λ v, rfl

@[simp] lemma dom_lcongr_symm (e : M ≃ₗ[R] M₂) :
  (dom_lcongr R N ι S e).symm = dom_lcongr R N ι S e.symm :=
rfl

lemma dom_lcongr_trans (e : M ≃ₗ[R] M₂) (f : M₂ ≃ₗ[R] M₃):
  (dom_lcongr R N ι S e).trans (dom_lcongr R N ι S f) = dom_lcongr R N ι S (e.trans f) :=
rfl

end dom_lcongr

/-- Composing an alternating map with the same linear equiv on each argument gives the zero map
if and only if the alternating map is the zero map. -/
@[simp] lemma comp_linear_equiv_eq_zero_iff (f : alternating_map R M N ι) (g : M₂ ≃ₗ[R] M) :
  f.comp_linear_map (g : M₂ →ₗ[R] M) = 0 ↔ f = 0 :=
(dom_lcongr R N ι ℕ g.symm).map_eq_zero_iff

variables (f f' : alternating_map R M N ι)
variables (g g₂ : alternating_map R M N' ι)
variables (g' : alternating_map R M' N' ι)
variables (v : ι → M) (v' : ι → M')
open function

/-!
### Other lemmas from `multilinear_map`
-/
section

open_locale big_operators

lemma map_update_sum {α : Type*} (t : finset α) (i : ι) (g : α → M) (m : ι → M):
  f (update m i (∑ a in t, g a)) = ∑ a in t, f (update m i (g a)) :=
f.to_multilinear_map.map_update_sum t i g m

end

/-!
### Theorems specific to alternating maps

Various properties of reordered and repeated inputs which follow from
`alternating_map.map_eq_zero_of_eq`.
-/

lemma map_update_self {i j : ι} (hij : i ≠ j) :
  f (function.update v i (v j)) = 0 :=
f.map_eq_zero_of_eq _ (by rw [function.update_same, function.update_noteq hij.symm]) hij

lemma map_update_update {i j : ι} (hij : i ≠ j) (m : M) :
  f (function.update (function.update v i m) j m) = 0 :=
f.map_eq_zero_of_eq _
  (by rw [function.update_same, function.update_noteq hij, function.update_same]) hij

lemma map_swap_add {i j : ι} (hij : i ≠ j) :
  f (v ∘ equiv.swap i j) + f v = 0 :=
begin
  rw equiv.comp_swap_eq_update,
  convert f.map_update_update v hij (v i + v j),
  simp [f.map_update_self _ hij,
        f.map_update_self _ hij.symm,
        function.update_comm hij (v i + v j) (v _) v,
        function.update_comm hij.symm (v i) (v i) v],
end

lemma map_add_swap {i j : ι} (hij : i ≠ j) :
  f v + f (v ∘ equiv.swap i j) = 0 :=
by { rw add_comm, exact f.map_swap_add v hij }

lemma map_swap {i j : ι} (hij : i ≠ j) : g (v ∘ equiv.swap i j) = - g v :=
eq_neg_of_add_eq_zero_left $ g.map_swap_add v hij

lemma map_perm [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
  g (v ∘ σ) = σ.sign • g v :=
begin
  apply equiv.perm.swap_induction_on' σ,
  { simp },
  { intros s x y hxy hI,
    simpa [g.map_swap (v ∘ s) hxy, equiv.perm.sign_swap hxy] using hI, }
end

lemma map_congr_perm [fintype ι] (σ : equiv.perm ι) :
  g v = σ.sign • g (v ∘ σ) :=
by { rw [g.map_perm, smul_smul], simp }

section dom_dom_congr

/-- Transfer the arguments to a map along an equivalence between argument indices.

This is the alternating version of `multilinear_map.dom_dom_congr`. -/
@[simps]
def dom_dom_congr (σ : ι ≃ ι') (f : alternating_map R M N ι) : alternating_map R M N ι' :=
{ to_fun := λ v, f (v ∘ σ),
  map_eq_zero_of_eq' := λ v i j hv hij,
    f.map_eq_zero_of_eq (v ∘ σ) (by simpa using hv) (σ.symm.injective.ne hij),
  .. f.to_multilinear_map.dom_dom_congr σ }

@[simp] lemma dom_dom_congr_refl (f : alternating_map R M N ι) :
  f.dom_dom_congr (equiv.refl ι) = f := ext $ λ v, rfl

lemma dom_dom_congr_trans (σ₁ : ι ≃ ι') (σ₂ : ι' ≃ ι'') (f : alternating_map R M N ι) :
  f.dom_dom_congr (σ₁.trans σ₂) = (f.dom_dom_congr σ₁).dom_dom_congr σ₂ := rfl

@[simp] lemma dom_dom_congr_zero (σ : ι ≃ ι') :
  (0 : alternating_map R M N ι).dom_dom_congr σ = 0 :=
rfl

@[simp] lemma dom_dom_congr_add (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
  (f + g).dom_dom_congr σ = f.dom_dom_congr σ + g.dom_dom_congr σ :=
rfl

/-- `alternating_map.dom_dom_congr` as an equivalence.

This is declared separately because it does not work with dot notation. -/
@[simps apply symm_apply]
def dom_dom_congr_equiv (σ : ι ≃ ι') :
  alternating_map R M N ι ≃+ alternating_map R M N ι' :=
{ to_fun := dom_dom_congr σ,
  inv_fun := dom_dom_congr σ.symm,
  left_inv := λ f, by { ext, simp [function.comp] },
  right_inv := λ m, by { ext, simp [function.comp] },
  map_add' := dom_dom_congr_add σ }

/-- The results of applying `dom_dom_congr` to two maps are equal if and only if those maps are. -/
@[simp] lemma dom_dom_congr_eq_iff (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
  f.dom_dom_congr σ = g.dom_dom_congr σ ↔ f = g :=
(dom_dom_congr_equiv σ : _ ≃+ alternating_map R M N ι').apply_eq_iff_eq

@[simp] lemma dom_dom_congr_eq_zero_iff (σ : ι ≃ ι') (f : alternating_map R M N ι) :
  f.dom_dom_congr σ = 0 ↔ f = 0 :=
(dom_dom_congr_equiv σ : alternating_map R M N ι ≃+ alternating_map R M N ι').map_eq_zero_iff

lemma dom_dom_congr_perm [fintype ι] (σ : equiv.perm ι) :
  g.dom_dom_congr σ = σ.sign • g :=
alternating_map.ext $ λ v, g.map_perm v σ

@[norm_cast] lemma coe_dom_dom_congr (σ : ι ≃ ι') :
  ↑(f.dom_dom_congr σ) = (f : multilinear_map R (λ _ : ι, M) N).dom_dom_congr σ :=
multilinear_map.ext $ λ v, rfl

end dom_dom_congr

/-- If the arguments are linearly dependent then the result is `0`. -/
lemma map_linear_dependent
  {K : Type*} [ring K]
  {M : Type*} [add_comm_group M] [module K M]
  {N : Type*} [add_comm_group N] [module K N] [no_zero_smul_divisors K N]
  (f : alternating_map K M N ι) (v : ι → M)
  (h : ¬linear_independent K v) :
  f v = 0 :=
begin
  obtain ⟨s, g, h, i, hi, hz⟩ := not_linear_independent_iff.mp h,
  suffices : f (update v i (g i • v i)) = 0,
  { rw [f.map_smul, function.update_eq_self, smul_eq_zero] at this,
    exact or.resolve_left this hz, },
  conv at h in (g _ • v _) { rw ←if_t_t (i = x) (g _ • v _), },
  rw [finset.sum_ite, finset.filter_eq, finset.filter_ne, if_pos hi, finset.sum_singleton,
    add_eq_zero_iff_eq_neg] at h,
  rw [h, f.map_neg, f.map_update_sum, neg_eq_zero, finset.sum_eq_zero],
  intros j hj,
  obtain ⟨hij, _⟩ := finset.mem_erase.mp hj,
  rw [f.map_smul, f.map_update_self _ hij.symm, smul_zero],
end

section fin
open fin

/-- A version of `multilinear_map.cons_add` for `alternating_map`. -/
lemma map_vec_cons_add {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M) (x y : M) :
  f (matrix.vec_cons (x+y) m) = f (matrix.vec_cons x m) + f (matrix.vec_cons y m) :=
f.to_multilinear_map.cons_add _ _ _

/-- A version of `multilinear_map.cons_smul` for `alternating_map`. -/
lemma map_vec_cons_smul {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M)
  (c : R) (x : M) :
  f (matrix.vec_cons (c • x) m) = c • f (matrix.vec_cons x m) :=
f.to_multilinear_map.cons_smul _ _ _

end fin

end alternating_map

open_locale big_operators

namespace multilinear_map

open equiv

variables [fintype ι]

private lemma alternization_map_eq_zero_of_eq_aux
  (m : multilinear_map R (λ i : ι, M) N')
  (v : ι → M) (i j : ι) (i_ne_j : i ≠ j) (hv : v i = v j) :
  (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ) v = 0 :=
begin
  rw sum_apply,
  exact finset.sum_involution
    (λ σ _, swap i j * σ)
    (λ σ _, by simp [perm.sign_swap i_ne_j, apply_swap_eq_self hv])
    (λ σ _ _, (not_congr swap_mul_eq_iff).mpr i_ne_j)
    (λ σ _, finset.mem_univ _)
    (λ σ _, swap_mul_involutive i j σ)
end

/-- Produce an `alternating_map` out of a `multilinear_map`, by summing over all argument
permutations. -/
def alternatization : multilinear_map R (λ i : ι, M) N' →+ alternating_map R M N' ι :=
{ to_fun := λ m,
  { to_fun := ⇑(∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ),
    map_eq_zero_of_eq' := λ v i j hvij hij, alternization_map_eq_zero_of_eq_aux m v i j hij hvij,
    .. (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ)},
  map_add' := λ a b, begin
    ext,
    simp only [
      finset.sum_add_distrib, smul_add, add_apply, dom_dom_congr_apply, alternating_map.add_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end,
  map_zero' := begin
    ext,
    simp only [
      finset.sum_const_zero, smul_zero, zero_apply, dom_dom_congr_apply, alternating_map.zero_apply,
      alternating_map.coe_mk, smul_apply, sum_apply],
  end }

lemma alternatization_def (m : multilinear_map R (λ i : ι, M) N') :
  ⇑(alternatization m) = (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ : _) :=
rfl

lemma alternatization_coe (m : multilinear_map R (λ i : ι, M) N') :
  ↑m.alternatization = (∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ : _) :=
coe_injective rfl

lemma alternatization_apply (m : multilinear_map R (λ i : ι, M) N') (v : ι → M) :
  alternatization m v = ∑ (σ : perm ι), σ.sign • m.dom_dom_congr σ v :=
by simp only [alternatization_def, smul_apply, sum_apply]

end multilinear_map

namespace alternating_map

/-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
where `n` is the number of inputs. -/
lemma coe_alternatization [fintype ι] (a : alternating_map R M N' ι) :
  (↑a : multilinear_map R (λ ι, M) N').alternatization = nat.factorial (fintype.card ι) • a :=
begin
  apply alternating_map.coe_injective,
  simp_rw [multilinear_map.alternatization_def, ←coe_dom_dom_congr, dom_dom_congr_perm, coe_smul,
    smul_smul, int.units_mul_self, one_smul, finset.sum_const, finset.card_univ, fintype.card_perm,
    ←coe_multilinear_map, coe_smul],
end

end alternating_map

namespace linear_map

variables {N'₂ : Type*} [add_comm_group N'₂] [module R N'₂] [fintype ι]

/-- Composition with a linear map before and after alternatization are equivalent. -/
lemma comp_multilinear_map_alternatization (g : N' →ₗ[R] N'₂)
  (f : multilinear_map R (λ _ : ι, M) N') :
  (g.comp_multilinear_map f).alternatization = g.comp_alternating_map (f.alternatization) :=
by { ext, simp [multilinear_map.alternatization_def] }

end linear_map

section coprod

open_locale big_operators
open_locale tensor_product

variables {ιa ιb : Type*} [decidable_eq ιa] [decidable_eq ιb] [fintype ιa] [fintype ιb]

variables
  {R' : Type*} {Mᵢ N₁ N₂ : Type*}
  [comm_semiring R']
  [add_comm_group N₁] [module R' N₁]
  [add_comm_group N₂] [module R' N₂]
  [add_comm_monoid Mᵢ] [module R' Mᵢ]

namespace equiv.perm

/-- Elements which are considered equivalent if they differ only by swaps within α or β  -/
abbreviation mod_sum_congr (α β : Type*) :=
_ ⧸ (equiv.perm.sum_congr_hom α β).range

lemma mod_sum_congr.swap_smul_involutive {α β : Type*} [decidable_eq (α ⊕ β)] (i j : α ⊕ β) :
  function.involutive (has_scalar.smul (equiv.swap i j) : mod_sum_congr α β → mod_sum_congr α β) :=
λ σ, begin
  apply σ.induction_on' (λ σ, _),
  exact _root_.congr_arg quotient.mk' (equiv.swap_mul_involutive i j σ)
end

end equiv.perm

namespace alternating_map
open equiv

/-- summand used in `alternating_map.dom_coprod` -/
def dom_coprod.summand
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb) :
  multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗[R'] N₂) :=
quotient.lift_on' σ
  (λ σ,
    σ.sign •
      (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ)
  (λ σ₁ σ₂ ⟨⟨sl, sr⟩, h⟩, begin
    ext v,
    simp only [multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply,
      coe_multilinear_map, multilinear_map.smul_apply],
    replace h := inv_mul_eq_iff_eq_mul.mp h.symm,
    have : (σ₁ * perm.sum_congr_hom _ _ (sl, sr)).sign = σ₁.sign * (sl.sign * sr.sign) :=
      by simp,
    rw [h, this, mul_smul, mul_smul, smul_left_cancel_iff,
      ←tensor_product.tmul_smul, tensor_product.smul_tmul'],
    simp only [sum.map_inr, perm.sum_congr_hom_apply, perm.sum_congr_apply, sum.map_inl,
              function.comp_app, perm.coe_mul],
    rw [←a.map_congr_perm (λ i, v (σ₁ _)), ←b.map_congr_perm (λ i, v (σ₁ _))],
  end)

lemma dom_coprod.summand_mk'
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : equiv.perm (ιa ⊕ ιb)) :
  dom_coprod.summand a b (quotient.mk' σ) = σ.sign •
    (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ :=
rfl

/-- Swapping elements in `σ` with equal values in `v` results in an addition that cancels -/
lemma dom_coprod.summand_add_swap_smul_eq_zero
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  dom_coprod.summand a b σ v + dom_coprod.summand a b (swap i j • σ) v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', mul_action.quotient.smul_mk,
    dom_coprod.summand],
  rw [smul_eq_mul, perm.sign_mul, perm.sign_swap hij],
  simp only [one_mul, neg_mul, function.comp_app, units.neg_smul, perm.coe_mul,
    units.coe_neg, multilinear_map.smul_apply, multilinear_map.neg_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply],
  convert add_right_neg _;
  { ext k, rw equiv.apply_swap_eq_self hv },
end

/-- Swapping elements in `σ` with equal values in `v` result in zero if the swap has no effect
on the quotient. -/
lemma dom_coprod.summand_eq_zero_of_smul_invariant
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb)
  (σ : perm.mod_sum_congr ιa ιb)
  {v : ιa ⊕ ιb → Mᵢ} {i j : ιa ⊕ ιb} (hv : v i = v j) (hij : i ≠ j) :
  swap i j • σ = σ → dom_coprod.summand a b σ v = 0 :=
begin
  apply σ.induction_on' (λ σ, _),
  dsimp only [quotient.lift_on'_mk', quotient.map'_mk', multilinear_map.smul_apply,
    multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply, dom_coprod.summand],
  intro hσ,
  with_cases
  { cases hi : σ⁻¹ i;
      cases hj : σ⁻¹ j;
      rw perm.inv_eq_iff_eq at hi hj;
      substs hi hj, },
  case [sum.inl sum.inr : i' j', sum.inr sum.inl : i' j']
  { -- the term pairs with and cancels another term
    all_goals { obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient.exact' hσ, },
    work_on_goal 1 { replace hσ := equiv.congr_fun hσ (sum.inl i'), },
    work_on_goal 2 { replace hσ := equiv.congr_fun hσ (sum.inr i'), },
    all_goals
    { rw [smul_eq_mul, ←mul_swap_eq_swap_mul, mul_inv_rev, swap_inv, inv_mul_cancel_right] at hσ,
      simpa using hσ, }, },
  case [sum.inr sum.inr : i' j', sum.inl sum.inl : i' j']
  { -- the term does not pair but is zero
    all_goals { convert smul_zero _, },
    work_on_goal 1 { convert tensor_product.tmul_zero _ _, },
    work_on_goal 2 { convert tensor_product.zero_tmul _ _, },
    all_goals { exact alternating_map.map_eq_zero_of_eq _ _ hv (λ hij', hij (hij' ▸ rfl)), } },
end

/-- Like `multilinear_map.dom_coprod`, but ensures the result is also alternating.

Note that this is usually defined (for instance, as used in Proposition 22.24 in [Gallier2011Notes])
over integer indices `ιa = fin n` and `ιb = fin m`, as
$$
(f \wedge g)(u_1, \ldots, u_{m+n}) =
  \sum_{\operatorname{shuffle}(m, n)} \operatorname{sign}(\sigma)
    f(u_{\sigma(1)}, \ldots, u_{\sigma(m)}) g(u_{\sigma(m+1)}, \ldots, u_{\sigma(m+n)}),
$$
where $\operatorname{shuffle}(m, n)$ consists of all permutations of $[1, m+n]$ such that
$\sigma(1) < \cdots < \sigma(m)$ and $\sigma(m+1) < \cdots < \sigma(m+n)$.

Here, we generalize this by replacing:
* the product in the sum with a tensor product
* the filtering of $[1, m+n]$ to shuffles with an isomorphic quotient
* the additions in the subscripts of $\sigma$ with an index of type `sum`

The specialized version can be obtained by combining this definition with `fin_sum_fin_equiv` and
`algebra.lmul'`.
-/
@[simps]
def dom_coprod
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
{ to_fun := λ v, ⇑(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) v,
  map_eq_zero_of_eq' := λ v i j hv hij, begin
    dsimp only,
    rw multilinear_map.sum_apply,
    exact finset.sum_involution
      (λ σ _, equiv.swap i j • σ)
      (λ σ _, dom_coprod.summand_add_swap_smul_eq_zero a b σ hv hij)
      (λ σ _, mt $ dom_coprod.summand_eq_zero_of_smul_invariant a b σ hv hij)
      (λ σ _, finset.mem_univ _)
      (λ σ _, equiv.perm.mod_sum_congr.swap_smul_involutive i j σ),
  end,
  ..(∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ) }

lemma dom_coprod_coe (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (↑(a.dom_coprod b) : multilinear_map R' (λ _, Mᵢ) _) =
    ∑ σ : perm.mod_sum_congr ιa ιb, dom_coprod.summand a b σ :=
multilinear_map.ext $ λ _, rfl

/-- A more bundled version of `alternating_map.dom_coprod` that maps
`((ι₁ → N) → N₁) ⊗ ((ι₂ → N) → N₂)` to `(ι₁ ⊕ ι₂ → N) → N₁ ⊗ N₂`. -/
def dom_coprod' :
  (alternating_map R' Mᵢ N₁ ιa ⊗[R'] alternating_map R' Mᵢ N₂ ιb) →ₗ[R']
    alternating_map R' Mᵢ (N₁ ⊗[R'] N₂) (ιa ⊕ ιb) :=
tensor_product.lift $ by
  refine linear_map.mk₂ R' (dom_coprod)
    (λ m₁ m₂ n, _)
    (λ c m n, _)
    (λ m n₁ n₂, _)
    (λ c m n, _);
  { ext,
    simp only [dom_coprod_apply, add_apply, smul_apply, ←finset.sum_add_distrib,
      finset.smul_sum, multilinear_map.sum_apply, dom_coprod.summand],
    congr,
    ext σ,
    apply σ.induction_on' (λ σ, _),
    simp only [quotient.lift_on'_mk', coe_add, coe_smul, multilinear_map.smul_apply,
      ←multilinear_map.dom_coprod'_apply],
    simp only [tensor_product.add_tmul, ←tensor_product.smul_tmul',
      tensor_product.tmul_add, tensor_product.tmul_smul, linear_map.map_add, linear_map.map_smul],
    rw ←smul_add <|> rw smul_comm,
    congr }

@[simp]
lemma dom_coprod'_apply
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  dom_coprod' (a ⊗ₜ[R'] b) = dom_coprod a b :=
by simp only [dom_coprod', tensor_product.lift.tmul, linear_map.mk₂_apply]

end alternating_map

open equiv

/-- A helper lemma for `multilinear_map.dom_coprod_alternization`. -/
lemma multilinear_map.dom_coprod_alternization_coe
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  multilinear_map.dom_coprod ↑a.alternatization ↑b.alternatization =
    ∑ (σa : perm ιa) (σb : perm ιb), σa.sign • σb.sign •
      multilinear_map.dom_coprod (a.dom_dom_congr σa) (b.dom_dom_congr σb) :=
begin
  simp_rw [←multilinear_map.dom_coprod'_apply, multilinear_map.alternatization_coe],
  simp_rw [tensor_product.sum_tmul, tensor_product.tmul_sum, linear_map.map_sum,
    ←tensor_product.smul_tmul', tensor_product.tmul_smul, linear_map.map_smul_of_tower],
end

open alternating_map

/-- Computing the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` is the same
as computing the `alternating_map.dom_coprod` of the `multilinear_map.alternatization`s.
-/
lemma multilinear_map.dom_coprod_alternization
  (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
  (multilinear_map.dom_coprod a b).alternatization =
    a.alternatization.dom_coprod b.alternatization :=
begin
  apply coe_multilinear_map_injective,
  rw [dom_coprod_coe, multilinear_map.alternatization_coe,
    finset.sum_partition (quotient_group.left_rel (perm.sum_congr_hom ιa ιb).range)],
  congr' 1,
  ext1 σ,
  apply σ.induction_on' (λ σ, _),

  -- unfold the quotient mess left by `finset.sum_partition`
  conv in (_ = quotient.mk' _)
  { change quotient.mk' _ = quotient.mk' _,
    rw quotient.eq',
    rw [quotient_group.left_rel],
    dsimp only [setoid.r] },

  -- eliminate a multiplication
  have : @finset.univ (perm (ιa ⊕ ιb)) _ = finset.univ.image ((*) σ) :=
    (finset.eq_univ_iff_forall.mpr $ λ a, let ⟨a', ha'⟩ := mul_left_surjective σ a in
      finset.mem_image.mpr ⟨a', finset.mem_univ _, ha'⟩).symm,
  rw [this, finset.image_filter],
  simp only [function.comp, mul_inv_rev, inv_mul_cancel_right, subgroup.inv_mem_iff],
  simp only [monoid_hom.mem_range], -- needs to be separate from the above `simp only`
  rw [finset.filter_congr_decidable,
    finset.univ_filter_exists (perm.sum_congr_hom ιa ιb),
    finset.sum_image (λ x _ y _ (h : _ = _), mul_right_injective _ h),
    finset.sum_image (λ x _ y _ (h : _ = _), perm.sum_congr_hom_injective h)],
  dsimp only,

  -- now we're ready to clean up the RHS, pulling out the summation
  rw [dom_coprod.summand_mk', multilinear_map.dom_coprod_alternization_coe,
    ←finset.sum_product', finset.univ_product_univ,
    ←multilinear_map.dom_dom_congr_equiv_apply, add_equiv.map_sum, finset.smul_sum],
  congr' 1,
  ext1 ⟨al, ar⟩,
  dsimp only,

  -- pull out the pair of smuls on the RHS, by rewriting to `_ →ₗ[ℤ] _` and back
  rw [←add_equiv.coe_to_add_monoid_hom, ←add_monoid_hom.coe_to_int_linear_map,
    linear_map.map_smul_of_tower,
    linear_map.map_smul_of_tower,
    add_monoid_hom.coe_to_int_linear_map, add_equiv.coe_to_add_monoid_hom,
    multilinear_map.dom_dom_congr_equiv_apply],

  -- pick up the pieces
  rw [multilinear_map.dom_dom_congr_mul, perm.sign_mul,
    perm.sum_congr_hom_apply, multilinear_map.dom_coprod_dom_dom_congr_sum_congr,
    perm.sign_sum_congr, mul_smul, mul_smul],
end

/-- Taking the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` of two
`alternating_map`s gives a scaled version of the `alternating_map.coprod` of those maps.
-/
lemma multilinear_map.dom_coprod_alternization_eq
  (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
  (multilinear_map.dom_coprod a b : multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗ N₂))
    .alternatization =
    ((fintype.card ιa).factorial * (fintype.card ιb).factorial) • a.dom_coprod b :=
begin
  rw [multilinear_map.dom_coprod_alternization, coe_alternatization, coe_alternatization, mul_smul,
    ←dom_coprod'_apply, ←dom_coprod'_apply, ←tensor_product.smul_tmul', tensor_product.tmul_smul,
    linear_map.map_smul_of_tower dom_coprod', linear_map.map_smul_of_tower dom_coprod'],
  -- typeclass resolution is a little confused here
  apply_instance, apply_instance,
end

end coprod

section basis

open alternating_map

variables {ι₁ : Type*} [fintype ι]
variables {R' : Type*} {N₁ N₂ : Type*} [comm_semiring R'] [add_comm_monoid N₁] [add_comm_monoid N₂]
variables [module R' N₁] [module R' N₂]

/-- Two alternating maps indexed by a `fintype` are equal if they are equal when all arguments
are distinct basis vectors. -/
lemma basis.ext_alternating {f g : alternating_map R' N₁ N₂ ι} (e : basis ι₁ R' N₁)
  (h : ∀ v : ι → ι₁, function.injective v → f (λ i, e (v i)) = g (λ i, e (v i))) : f = g :=
begin
  refine alternating_map.coe_multilinear_map_injective (basis.ext_multilinear e $ λ v, _),
  by_cases hi : function.injective v,
  { exact h v hi },
  { have : ¬function.injective (λ i, e (v i)) := hi.imp function.injective.of_comp,
    rw [coe_multilinear_map, coe_multilinear_map,
        f.map_eq_zero_of_not_injective _ this, g.map_eq_zero_of_not_injective _ this], }
end

end basis

/-! ### Currying -/

section currying

variables
  {R' : Type*} {M'' M₂'' N'' N₂'': Type*}
  [comm_semiring R']
  [add_comm_monoid M''] [add_comm_monoid M₂''] [add_comm_monoid N''] [add_comm_monoid N₂'']
  [module R' M''] [module R' M₂''] [module R' N''] [module R' N₂'']

namespace alternating_map

/-- Given an alternating map `f` in `n+1` variables, split the first variable to obtain
a linear map into alternating maps in `n` variables, given by `x ↦ (m ↦ f (matrix.vec_cons x m))`.
It can be thought of as a map $Hom(\bigwedge^{n+1} M, N) \to Hom(M, Hom(\bigwedge^n M, N))$.

This is `multilinear_map.curry_left` for `alternating_map`. See also
`alternating_map.curry_left_linear_map`. -/
@[simps]
def curry_left {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ)) :
  M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
{ to_fun := λ m,
  { to_fun    := λ v, f (matrix.vec_cons m v),
    map_eq_zero_of_eq' := λ v i j hv hij, f.map_eq_zero_of_eq _
      (by rwa [matrix.cons_val_succ, matrix.cons_val_succ]) ((fin.succ_injective _).ne hij),
    .. f.to_multilinear_map.curry_left m },
  map_add' := λ m₁ m₂, ext $ λ v, f.map_vec_cons_add _ _ _,
  map_smul' := λ r m, ext $ λ v, f.map_vec_cons_smul _ _ _ }

@[simp] lemma curry_left_zero {n : ℕ} :
  curry_left (0 : alternating_map R' M'' N'' (fin n.succ)) = 0 := rfl

@[simp] lemma curry_left_add {n : ℕ} (f g : alternating_map R' M'' N'' (fin n.succ)) :
  curry_left (f + g) = curry_left f + curry_left g := rfl

@[simp] lemma curry_left_smul {n : ℕ} (r : R') (f : alternating_map R' M'' N'' (fin n.succ)) :
  curry_left (r • f) = r • curry_left f := rfl

/-- `alternating_map.curry_left` as a `linear_map`. This is a separate definition as dot notation
does not work for this version. -/
@[simps]
def curry_left_linear_map {n : ℕ} :
  alternating_map R' M'' N'' (fin n.succ) →ₗ[R'] M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
{ to_fun := λ f, f.curry_left,
  map_add' := curry_left_add,
  map_smul' := curry_left_smul }

/-- Currying with the same element twice gives the zero map. -/
@[simp] lemma curry_left_same {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ.succ)) (m : M'') :
  (f.curry_left m).curry_left m = 0 :=
ext $ λ x, f.map_eq_zero_of_eq _ (by simp) fin.zero_ne_one

@[simp] lemma curry_left_comp_alternating_map {n : ℕ} (g : N'' →ₗ[R'] N₂'')
  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M'') :
  (g.comp_alternating_map f).curry_left m = g.comp_alternating_map (f.curry_left m) :=
rfl

@[simp] lemma curry_left_comp_linear_map {n : ℕ} (g : M₂'' →ₗ[R'] M'')
  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M₂'') :
  (f.comp_linear_map g).curry_left m = (f.curry_left (g m)).comp_linear_map g :=
ext $ λ v, congr_arg f $ funext $ begin
  refine fin.cases _ _,
  { refl },
  { simp }
end

/-- The space of constant maps is equivalent to the space of maps that are alternating with respect
to an empty family. -/
@[simps] def const_linear_equiv_of_is_empty [is_empty ι] :
  N'' ≃ₗ[R'] alternating_map R' M'' N'' ι :=
{ to_fun    := alternating_map.const_of_is_empty R' M'',
  map_add'  := λ x y, rfl,
  map_smul' := λ t x, rfl,
  inv_fun   := λ f, f 0,
  left_inv  := λ _, rfl,
  right_inv := λ f, ext $ λ x, alternating_map.congr_arg f $ subsingleton.elim _ _ }

end alternating_map

end currying


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.ordering.lemmas
! leanprover-community/mathlib commit 4bd314f7bd5e0c9e813fc201f1279a23f13f9f1d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Ordering.Basic
import Leanbin.Init.Meta.Default
import Leanbin.Init.Algebra.Classes
import Leanbin.Init.IteSimp

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option default_priority -/
set_option default_priority 100

universe u

namespace Ordering

@[simp]
theorem ite_eq_lt_distrib (c : Prop) [Decidable c] (a b : Ordering) :
    ((if c then a else b) = Ordering.lt) = if c then a = Ordering.lt else b = Ordering.lt := by
  by_cases c <;> simp [*]
#align ordering.ite_eq_lt_distrib Ordering.ite_eq_lt_distrib

@[simp]
theorem ite_eq_eq_distrib (c : Prop) [Decidable c] (a b : Ordering) :
    ((if c then a else b) = Ordering.eq) = if c then a = Ordering.eq else b = Ordering.eq := by
  by_cases c <;> simp [*]
#align ordering.ite_eq_eq_distrib Ordering.ite_eq_eq_distrib

@[simp]
theorem ite_eq_gt_distrib (c : Prop) [Decidable c] (a b : Ordering) :
    ((if c then a else b) = Ordering.gt) = if c then a = Ordering.gt else b = Ordering.gt := by
  by_cases c <;> simp [*]
#align ordering.ite_eq_gt_distrib Ordering.ite_eq_gt_distrib

-- ------------------------------------------------------------------
end Ordering

section

variable {α : Type u} {lt : α → α → Prop} [DecidableRel lt]

attribute [local simp] cmpUsing

@[simp]
theorem cmpUsing_eq_lt (a b : α) : (cmpUsing lt a b = Ordering.lt) = lt a b := by simp
#align cmp_using_eq_lt cmpUsing_eq_lt

@[simp]
theorem cmpUsing_eq_gt [IsStrictOrder α lt] (a b : α) : (cmpUsing lt a b = Ordering.gt) = lt b a :=
  by
  simp; apply propext; apply Iff.intro
  · exact fun h => h.2
  · intro hba
    constructor
    · intro hab
      exact absurd (trans hab hba) (irrefl a)
    · assumption
#align cmp_using_eq_gt cmpUsing_eq_gt

@[simp]
theorem cmpUsing_eq_eq (a b : α) : (cmpUsing lt a b = Ordering.eq) = (¬lt a b ∧ ¬lt b a) := by simp
#align cmp_using_eq_eq cmpUsing_eq_eq

end


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

! This file was ported from Lean 3 source module ring_theory.artinian
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Nakayama
import Mathbin.Data.SetLike.Fintype

/-!
# Artinian rings and modules

A module satisfying these equivalent conditions is said to be an *Artinian* R-module
if every decreasing chain of submodules is eventually constant, or equivalently,
if the relation `<` on submodules is well founded.

A ring is said to be left (or right) Artinian if it is Artinian as a left (or right) module over
itself, or simply Artinian if it is both left and right Artinian.

## Main definitions

Let `R` be a ring and let `M` and `P` be `R`-modules. Let `N` be an `R`-submodule of `M`.

* `is_artinian R M` is the proposition that `M` is a Artinian `R`-module. It is a class,
  implemented as the predicate that the `<` relation on submodules is well founded.
* `is_artinian_ring R` is the proposition that `R` is a left Artinian ring.

## References

* [M. F. Atiyah and I. G. Macdonald, *Introduction to commutative algebra*][atiyah-macdonald]
* [samuel]

## Tags

Artinian, artinian, Artinian ring, Artinian module, artinian ring, artinian module

-/

open Set

open BigOperators Pointwise

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`wellFounded_submodule_lt] [] -/
/-- `is_artinian R M` is the proposition that `M` is an Artinian `R`-module,
implemented as the well-foundedness of submodule inclusion.
-/
class IsArtinian (R M) [Semiring R] [AddCommMonoid M] [Module R M] : Prop where
  wellFounded_submodule_lt : WellFounded ((· < ·) : Submodule R M → Submodule R M → Prop)
#align is_artinian IsArtinian

section

variable {R M P N : Type _}

variable [Ring R] [AddCommGroup M] [AddCommGroup P] [AddCommGroup N]

variable [Module R M] [Module R P] [Module R N]

open IsArtinian

include R

theorem isArtinian_of_injective (f : M →ₗ[R] P) (h : Function.Injective f) [IsArtinian R P] :
    IsArtinian R M :=
  ⟨Subrelation.wf
      (fun A B hAB => show A.map f < B.map f from Submodule.map_strictMono_of_injective h hAB)
      (InvImage.wf (Submodule.map f) (IsArtinian.wellFounded_submodule_lt R P))⟩
#align is_artinian_of_injective isArtinian_of_injective

instance isArtinian_submodule' [IsArtinian R M] (N : Submodule R M) : IsArtinian R N :=
  isArtinian_of_injective N.Subtype Subtype.val_injective
#align is_artinian_submodule' isArtinian_submodule'

theorem isArtinian_of_le {s t : Submodule R M} [ht : IsArtinian R t] (h : s ≤ t) : IsArtinian R s :=
  isArtinian_of_injective (Submodule.ofLe h) (Submodule.ofLe_injective h)
#align is_artinian_of_le isArtinian_of_le

variable (M)

theorem isArtinian_of_surjective (f : M →ₗ[R] P) (hf : Function.Surjective f) [IsArtinian R M] :
    IsArtinian R P :=
  ⟨Subrelation.wf
      (fun A B hAB =>
        show A.comap f < B.comap f from Submodule.comap_strictMono_of_surjective hf hAB)
      (InvImage.wf (Submodule.comap f) (IsArtinian.wellFounded_submodule_lt _ _))⟩
#align is_artinian_of_surjective isArtinian_of_surjective

variable {M}

theorem isArtinian_of_linearEquiv (f : M ≃ₗ[R] P) [IsArtinian R M] : IsArtinian R P :=
  isArtinian_of_surjective _ f.toLinearMap f.toEquiv.Surjective
#align is_artinian_of_linear_equiv isArtinian_of_linearEquiv

theorem isArtinian_of_range_eq_ker [IsArtinian R M] [IsArtinian R P] (f : M →ₗ[R] N) (g : N →ₗ[R] P)
    (hf : Function.Injective f) (hg : Function.Surjective g) (h : f.range = g.ker) :
    IsArtinian R N :=
  ⟨wellFounded_lt_exact_sequence (IsArtinian.wellFounded_submodule_lt _ _)
      (IsArtinian.wellFounded_submodule_lt _ _) f.range (Submodule.map f) (Submodule.comap f)
      (Submodule.comap g) (Submodule.map g) (Submodule.gciMapComap hf) (Submodule.giMapComap hg)
      (by simp [Submodule.map_comap_eq, inf_comm]) (by simp [Submodule.comap_map_eq, h])⟩
#align is_artinian_of_range_eq_ker isArtinian_of_range_eq_ker

instance isArtinian_prod [IsArtinian R M] [IsArtinian R P] : IsArtinian R (M × P) :=
  isArtinian_of_range_eq_ker (LinearMap.inl R M P) (LinearMap.snd R M P) LinearMap.inl_injective
    LinearMap.snd_surjective (LinearMap.range_inl R M P)
#align is_artinian_prod isArtinian_prod

instance (priority := 100) isArtinian_of_finite [Finite M] : IsArtinian R M :=
  ⟨Finite.wellFounded_of_trans_of_irrefl _⟩
#align is_artinian_of_finite isArtinian_of_finite

attribute [local elab_as_elim] Finite.induction_empty_option

instance isArtinian_pi {R ι : Type _} [Finite ι] :
    ∀ {M : ι → Type _} [Ring R] [∀ i, AddCommGroup (M i)],
      ∀ [∀ i, Module R (M i)], ∀ [∀ i, IsArtinian R (M i)], IsArtinian R (∀ i, M i) :=
  Finite.induction_empty_option
    (by
      intro α β e hα M _ _ _ _
      exact isArtinian_of_linearEquiv (LinearEquiv.piCongrLeft R M e))
    (by
      intro M _ _ _ _
      infer_instance)
    (by
      intro α _ ih M _ _ _ _
      exact isArtinian_of_linearEquiv (LinearEquiv.piOptionEquivProd R).symm)
    ι
#align is_artinian_pi isArtinian_pi

/-- A version of `is_artinian_pi` for non-dependent functions. We need this instance because
sometimes Lean fails to apply the dependent version in non-dependent settings (e.g., it fails to
prove that `ι → ℝ` is finite dimensional over `ℝ`). -/
instance isArtinian_pi' {R ι M : Type _} [Ring R] [AddCommGroup M] [Module R M] [Finite ι]
    [IsArtinian R M] : IsArtinian R (ι → M) :=
  isArtinian_pi
#align is_artinian_pi' isArtinian_pi'

end

open IsArtinian Submodule Function

section Ring

variable {R M : Type _} [Ring R] [AddCommGroup M] [Module R M]

theorem isArtinian_iff_wellFounded :
    IsArtinian R M ↔ WellFounded ((· < ·) : Submodule R M → Submodule R M → Prop) :=
  ⟨fun h => h.1, IsArtinian.mk⟩
#align is_artinian_iff_well_founded isArtinian_iff_wellFounded

variable {R M}

theorem IsArtinian.finite_of_linearIndependent [Nontrivial R] [IsArtinian R M] {s : Set M}
    (hs : LinearIndependent R (coe : s → M)) : s.Finite :=
  by
  refine'
    by_contradiction fun hf =>
      (RelEmbedding.wellFounded_iff_no_descending_seq.1 (well_founded_submodule_lt R M)).elim' _
  have f : ℕ ↪ s := Set.Infinite.natEmbedding s hf
  have : ∀ n, coe ∘ f '' { m | n ≤ m } ⊆ s :=
    by
    rintro n x ⟨y, hy₁, rfl⟩
    exact (f y).2
  have : ∀ a b : ℕ, a ≤ b ↔ span R (coe ∘ f '' { m | b ≤ m }) ≤ span R (coe ∘ f '' { m | a ≤ m }) :=
    by
    intro a b
    rw [span_le_span_iff hs (this b) (this a),
      Set.image_subset_image_iff (subtype.coe_injective.comp f.injective), Set.subset_def]
    simp only [Set.mem_setOf_eq]
    exact ⟨fun hab x => le_trans hab, fun h => h _ le_rfl⟩
  exact
    ⟨⟨fun n => span R (coe ∘ f '' { m | n ≤ m }), fun x y => by
        simp (config := { contextual := true }) [le_antisymm_iff, (this _ _).symm]⟩,
      by
      intro a b
      conv_rhs => rw [GT.gt, lt_iff_le_not_le, this, this, ← lt_iff_le_not_le]
      simp⟩
#align is_artinian.finite_of_linear_independent IsArtinian.finite_of_linearIndependent

/-- A module is Artinian iff every nonempty set of submodules has a minimal submodule among them.
-/
theorem set_has_minimal_iff_artinian :
    (∀ a : Set <| Submodule R M, a.Nonempty → ∃ M' ∈ a, ∀ I ∈ a, I ≤ M' → I = M') ↔
      IsArtinian R M :=
  by rw [isArtinian_iff_wellFounded, WellFounded.wellFounded_iff_has_min']
#align set_has_minimal_iff_artinian set_has_minimal_iff_artinian

theorem IsArtinian.set_has_minimal [IsArtinian R M] (a : Set <| Submodule R M) (ha : a.Nonempty) :
    ∃ M' ∈ a, ∀ I ∈ a, I ≤ M' → I = M' :=
  set_has_minimal_iff_artinian.mpr ‹_› a ha
#align is_artinian.set_has_minimal IsArtinian.set_has_minimal

/-- A module is Artinian iff every decreasing chain of submodules stabilizes. -/
theorem monotone_stabilizes_iff_artinian :
    (∀ f : ℕ →o (Submodule R M)ᵒᵈ, ∃ n, ∀ m, n ≤ m → f n = f m) ↔ IsArtinian R M :=
  by
  rw [isArtinian_iff_wellFounded]
  exact well_founded.monotone_chain_condition.symm
#align monotone_stabilizes_iff_artinian monotone_stabilizes_iff_artinian

namespace IsArtinian

variable [IsArtinian R M]

theorem monotone_stabilizes (f : ℕ →o (Submodule R M)ᵒᵈ) : ∃ n, ∀ m, n ≤ m → f n = f m :=
  monotone_stabilizes_iff_artinian.mpr ‹_› f
#align is_artinian.monotone_stabilizes IsArtinian.monotone_stabilizes

/-- If `∀ I > J, P I` implies `P J`, then `P` holds for all submodules. -/
theorem induction {P : Submodule R M → Prop} (hgt : ∀ I, (∀ J < I, P J) → P I) (I : Submodule R M) :
    P I :=
  (wellFounded_submodule_lt R M).recursion I hgt
#align is_artinian.induction IsArtinian.induction

/-- For any endomorphism of a Artinian module, there is some nontrivial iterate
with disjoint kernel and range.
-/
theorem exists_endomorphism_iterate_ker_sup_range_eq_top (f : M →ₗ[R] M) :
    ∃ n : ℕ, n ≠ 0 ∧ (f ^ n).ker ⊔ (f ^ n).range = ⊤ :=
  by
  obtain ⟨n, w⟩ :=
    monotone_stabilizes (f.iterate_range.comp ⟨fun n => n + 1, fun n m w => by linarith⟩)
  specialize w (n + 1 + n) (by linarith)
  dsimp at w
  refine' ⟨n + 1, Nat.succ_ne_zero _, _⟩
  simp_rw [eq_top_iff', mem_sup]
  intro x
  have : (f ^ (n + 1)) x ∈ (f ^ (n + 1 + n + 1)).range :=
    by
    rw [← w]
    exact mem_range_self _
  rcases this with ⟨y, hy⟩
  use x - (f ^ (n + 1)) y
  constructor
  · rw [LinearMap.mem_ker, LinearMap.map_sub, ← hy, sub_eq_zero, pow_add]
    simp [iterate_add_apply]
  · use (f ^ (n + 1)) y
    simp
#align is_artinian.exists_endomorphism_iterate_ker_sup_range_eq_top IsArtinian.exists_endomorphism_iterate_ker_sup_range_eq_top

/-- Any injective endomorphism of an Artinian module is surjective. -/
theorem surjective_of_injective_endomorphism (f : M →ₗ[R] M) (s : Injective f) : Surjective f :=
  by
  obtain ⟨n, ne, w⟩ := exists_endomorphism_iterate_ker_sup_range_eq_top f
  rw [linear_map.ker_eq_bot.mpr (LinearMap.iterate_injective s n), bot_sup_eq,
    LinearMap.range_eq_top] at w
  exact LinearMap.surjective_of_iterate_surjective Ne w
#align is_artinian.surjective_of_injective_endomorphism IsArtinian.surjective_of_injective_endomorphism

/-- Any injective endomorphism of an Artinian module is bijective. -/
theorem bijective_of_injective_endomorphism (f : M →ₗ[R] M) (s : Injective f) : Bijective f :=
  ⟨s, surjective_of_injective_endomorphism f s⟩
#align is_artinian.bijective_of_injective_endomorphism IsArtinian.bijective_of_injective_endomorphism

/-- A sequence `f` of submodules of a artinian module,
with the supremum `f (n+1)` and the infinum of `f 0`, ..., `f n` being ⊤,
is eventually ⊤.
-/
theorem disjoint_partial_infs_eventually_top (f : ℕ → Submodule R M)
    (h : ∀ n, Disjoint (partialSups (OrderDual.toDual ∘ f) n) (OrderDual.toDual (f (n + 1)))) :
    ∃ n : ℕ, ∀ m, n ≤ m → f m = ⊤ :=
  by
  -- A little off-by-one cleanup first:
  rsuffices ⟨n, w⟩ : ∃ n : ℕ, ∀ m, n ≤ m → OrderDual.toDual f (m + 1) = ⊤
  · use n + 1
    rintro (_ | m) p
    · cases p
    · apply w
      exact nat.succ_le_succ_iff.mp p
  obtain ⟨n, w⟩ := monotone_stabilizes (partialSups (OrderDual.toDual ∘ f))
  refine' ⟨n, fun m p => _⟩
  exact (h m).eq_bot_of_ge (sup_eq_left.1 <| (w (m + 1) <| le_add_right p).symm.trans <| w m p)
#align is_artinian.disjoint_partial_infs_eventually_top IsArtinian.disjoint_partial_infs_eventually_top

end IsArtinian

end Ring

section CommRing

variable {R : Type _} (M : Type _) [CommRing R] [AddCommGroup M] [Module R M] [IsArtinian R M]

namespace IsArtinian

theorem range_smul_pow_stabilizes (r : R) :
    ∃ n : ℕ,
      ∀ m,
        n ≤ m →
          (r ^ n • LinearMap.id : M →ₗ[R] M).range = (r ^ m • LinearMap.id : M →ₗ[R] M).range :=
  monotone_stabilizes
    ⟨fun n => (r ^ n • LinearMap.id : M →ₗ[R] M).range, fun n m h x ⟨y, hy⟩ =>
      ⟨r ^ (m - n) • y, by
        dsimp at hy⊢
        rw [← smul_assoc, smul_eq_mul, ← pow_add, ← hy, add_tsub_cancel_of_le h]⟩⟩
#align is_artinian.range_smul_pow_stabilizes IsArtinian.range_smul_pow_stabilizes

variable {M}

theorem exists_pow_succ_smul_dvd (r : R) (x : M) : ∃ (n : ℕ)(y : M), r ^ n.succ • y = r ^ n • x :=
  by
  obtain ⟨n, hn⟩ := IsArtinian.range_smul_pow_stabilizes M r
  simp_rw [SetLike.ext_iff] at hn
  exact ⟨n, by simpa using hn n.succ n.le_succ (r ^ n • x)⟩
#align is_artinian.exists_pow_succ_smul_dvd IsArtinian.exists_pow_succ_smul_dvd

end IsArtinian

end CommRing

-- TODO: Prove this for artinian modules
-- /--
-- If `M ⊕ N` embeds into `M`, for `M` noetherian over `R`, then `N` is trivial.
-- -/
-- universe w
-- variables {N : Type w} [add_comm_group N] [module R N]
-- noncomputable def is_noetherian.equiv_punit_of_prod_injective [is_noetherian R M]
--   (f : M × N →ₗ[R] M) (i : injective f) : N ≃ₗ[R] punit.{w+1} :=
-- begin
--   apply nonempty.some,
--   obtain ⟨n, w⟩ := is_noetherian.disjoint_partial_sups_eventually_bot (f.tailing i)
--     (f.tailings_disjoint_tailing i),
--   specialize w n (le_refl n),
--   apply nonempty.intro,
--   refine (f.tailing_linear_equiv i n).symm.trans _,
--   rw w,
--   exact submodule.bot_equiv_punit,
-- end
/-- A ring is Artinian if it is Artinian as a module over itself.

Strictly speaking, this should be called `is_left_artinian_ring` but we omit the `left_` for
convenience in the commutative case. For a right Artinian ring, use `is_artinian Rᵐᵒᵖ R`. -/
@[reducible]
def IsArtinianRing (R) [Ring R] :=
  IsArtinian R R
#align is_artinian_ring IsArtinianRing

theorem isArtinianRing_iff {R} [Ring R] : IsArtinianRing R ↔ IsArtinian R R :=
  Iff.rfl
#align is_artinian_ring_iff isArtinianRing_iff

theorem Ring.is_artinian_of_zero_eq_one {R} [Ring R] (h01 : (0 : R) = 1) : IsArtinianRing R :=
  have := subsingleton_of_zero_eq_one h01
  inferInstance
#align ring.is_artinian_of_zero_eq_one Ring.is_artinian_of_zero_eq_one

theorem isArtinian_of_submodule_of_artinian (R M) [Ring R] [AddCommGroup M] [Module R M]
    (N : Submodule R M) (h : IsArtinian R M) : IsArtinian R N := by infer_instance
#align is_artinian_of_submodule_of_artinian isArtinian_of_submodule_of_artinian

theorem isArtinian_of_quotient_of_artinian (R) [Ring R] (M) [AddCommGroup M] [Module R M]
    (N : Submodule R M) (h : IsArtinian R M) : IsArtinian R (M ⧸ N) :=
  isArtinian_of_surjective M (Submodule.mkQ N) (Submodule.Quotient.mk_surjective N)
#align is_artinian_of_quotient_of_artinian isArtinian_of_quotient_of_artinian

/-- If `M / S / R` is a scalar tower, and `M / R` is Artinian, then `M / S` is
also Artinian. -/
theorem isArtinian_of_tower (R) {S M} [CommRing R] [Ring S] [AddCommGroup M] [Algebra R S]
    [Module S M] [Module R M] [IsScalarTower R S M] (h : IsArtinian R M) : IsArtinian S M :=
  by
  rw [isArtinian_iff_wellFounded] at h⊢
  refine' (Submodule.restrictScalarsEmbedding R S M).WellFounded h
#align is_artinian_of_tower isArtinian_of_tower

theorem isArtinian_of_fg_of_artinian {R M} [Ring R] [AddCommGroup M] [Module R M]
    (N : Submodule R M) [IsArtinianRing R] (hN : N.Fg) : IsArtinian R N :=
  by
  let ⟨s, hs⟩ := hN
  haveI := Classical.decEq M
  haveI := Classical.decEq R
  have : ∀ x ∈ s, x ∈ N := fun x hx => hs ▸ Submodule.subset_span hx
  refine' @isArtinian_of_surjective ((↑s : Set M) → R) _ _ _ (Pi.module _ _ _) _ _ _ isArtinian_pi
  · fapply LinearMap.mk
    · exact fun f => ⟨∑ i in s.attach, f i • i.1, N.sum_mem fun c _ => N.smul_mem _ <| this _ c.2⟩
    · intro f g
      apply Subtype.eq
      change (∑ i in s.attach, (f i + g i) • _) = _
      simp only [add_smul, Finset.sum_add_distrib]
      rfl
    · intro c f
      apply Subtype.eq
      change (∑ i in s.attach, (c • f i) • _) = _
      simp only [smul_eq_mul, mul_smul]
      exact finset.smul_sum.symm
  rintro ⟨n, hn⟩
  change n ∈ N at hn
  rw [← hs, ← Set.image_id ↑s, Finsupp.mem_span_image_iff_total] at hn
  rcases hn with ⟨l, hl1, hl2⟩
  refine' ⟨fun x => l x, Subtype.ext _⟩
  change (∑ i in s.attach, l i • (i : M)) = n
  rw [@Finset.sum_attach M M s _ fun i => l i • i, ← hl2, Finsupp.total_apply, Finsupp.sum, eq_comm]
  refine' Finset.sum_subset hl1 fun x _ hx => _
  rw [Finsupp.not_mem_support_iff.1 hx, zero_smul]
#align is_artinian_of_fg_of_artinian isArtinian_of_fg_of_artinian

theorem isArtinian_of_fg_of_artinian' {R M} [Ring R] [AddCommGroup M] [Module R M]
    [IsArtinianRing R] (h : (⊤ : Submodule R M).Fg) : IsArtinian R M :=
  have : IsArtinian R (⊤ : Submodule R M) := isArtinian_of_fg_of_artinian _ h
  isArtinian_of_linearEquiv (LinearEquiv.ofTop (⊤ : Submodule R M) rfl)
#align is_artinian_of_fg_of_artinian' isArtinian_of_fg_of_artinian'

/-- In a module over a artinian ring, the submodule generated by finitely many vectors is
artinian. -/
theorem isArtinian_span_of_finite (R) {M} [Ring R] [AddCommGroup M] [Module R M] [IsArtinianRing R]
    {A : Set M} (hA : A.Finite) : IsArtinian R (Submodule.span R A) :=
  isArtinian_of_fg_of_artinian _ (Submodule.fg_def.mpr ⟨A, hA, rfl⟩)
#align is_artinian_span_of_finite isArtinian_span_of_finite

theorem Function.Surjective.isArtinianRing {R} [Ring R] {S} [Ring S] {F} [RingHomClass F R S]
    {f : F} (hf : Function.Surjective f) [H : IsArtinianRing R] : IsArtinianRing S :=
  by
  rw [isArtinianRing_iff, isArtinian_iff_wellFounded] at H⊢
  exact (Ideal.orderEmbeddingOfSurjective f hf).WellFounded H
#align function.surjective.is_artinian_ring Function.Surjective.isArtinianRing

instance isArtinianRing_range {R} [Ring R] {S} [Ring S] (f : R →+* S) [IsArtinianRing R] :
    IsArtinianRing f.range :=
  f.rangeRestrict_surjective.IsArtinianRing
#align is_artinian_ring_range isArtinianRing_range

namespace IsArtinianRing

open IsArtinian

variable {R : Type _} [CommRing R] [IsArtinianRing R]

theorem isNilpotent_jacobson_bot : IsNilpotent (Ideal.jacobson (⊥ : Ideal R)) :=
  by
  let Jac := Ideal.jacobson (⊥ : Ideal R)
  let f : ℕ →o (Ideal R)ᵒᵈ := ⟨fun n => Jac ^ n, fun _ _ h => Ideal.pow_le_pow h⟩
  obtain ⟨n, hn⟩ : ∃ n, ∀ m, n ≤ m → Jac ^ n = Jac ^ m := IsArtinian.monotone_stabilizes f
  refine' ⟨n, _⟩
  let J : Ideal R := annihilator (Jac ^ n)
  suffices J = ⊤ by
    have hJ : J • Jac ^ n = ⊥ := annihilator_smul (Jac ^ n)
    simpa only [this, top_smul, Ideal.zero_eq_bot] using hJ
  by_contra hJ
  change J ≠ ⊤ at hJ
  rcases IsArtinian.set_has_minimal { J' : Ideal R | J < J' } ⟨⊤, hJ.lt_top⟩ with
    ⟨J', hJJ' : J < J', hJ' : ∀ I, J < I → I ≤ J' → I = J'⟩
  rcases SetLike.exists_of_lt hJJ' with ⟨x, hxJ', hxJ⟩
  obtain rfl : J ⊔ Ideal.span {x} = J' :=
    by
    refine' hJ' (J ⊔ Ideal.span {x}) _ _
    · rw [SetLike.lt_iff_le_and_exists]
      exact ⟨le_sup_left, ⟨x, mem_sup_right (mem_span_singleton_self x), hxJ⟩⟩
    · exact sup_le hJJ'.le (span_le.2 (singleton_subset_iff.2 hxJ'))
  have : J ⊔ Jac • Ideal.span {x} ≤ J ⊔ Ideal.span {x} :=
    sup_le_sup_left (smul_le.2 fun _ _ _ => Submodule.smul_mem _ _) _
  have : Jac * Ideal.span {x} ≤ J := by
    classical
      --Need version 4 of Nakayamas lemma on Stacks
      by_contra H
      refine'
        H (smul_sup_le_of_le_smul_of_le_jacobson_bot (fg_span_singleton _) le_rfl (hJ' _ _ this).ge)
      exact lt_of_le_of_ne le_sup_left fun h => H <| h.symm ▸ le_sup_right
  have : Ideal.span {x} * Jac ^ (n + 1) ≤ ⊥
  calc
    Ideal.span {x} * Jac ^ (n + 1) = Ideal.span {x} * Jac * Jac ^ n := by rw [pow_succ, ← mul_assoc]
    _ ≤ J * Jac ^ n := (mul_le_mul (by rwa [mul_comm]) le_rfl)
    _ = ⊥ := by simp [J]

  refine' hxJ (mem_annihilator.2 fun y hy => (mem_bot R).1 _)
  refine' this (mul_mem_mul (mem_span_singleton_self x) _)
  rwa [← hn (n + 1) (Nat.le_succ _)]
#align is_artinian_ring.is_nilpotent_jacobson_bot IsArtinianRing.isNilpotent_jacobson_bot

section Localization

variable (S : Submonoid R) (L : Type _) [CommRing L] [Algebra R L] [IsLocalization S L]

include S

/-- Localizing an artinian ring can only reduce the amount of elements. -/
theorem localization_surjective : Function.Surjective (algebraMap R L) :=
  by
  intro r'
  obtain ⟨r₁, s, rfl⟩ := IsLocalization.mk'_surjective S r'
  obtain ⟨r₂, h⟩ : ∃ r : R, IsLocalization.mk' L 1 s = algebraMap R L r
  swap; · exact ⟨r₁ * r₂, by rw [IsLocalization.mk'_eq_mul_mk'_one, map_mul, h]⟩
  obtain ⟨n, r, hr⟩ := IsArtinian.exists_pow_succ_smul_dvd (s : R) (1 : R)
  use r
  rw [smul_eq_mul, smul_eq_mul, pow_succ', mul_assoc] at hr
  apply_fun algebraMap R L  at hr
  simp only [map_mul, ← [anonymous]] at hr
  rw [← IsLocalization.mk'_one L, IsLocalization.mk'_eq_iff_eq, mul_one, Submonoid.coe_one, ←
    (IsLocalization.map_units L (s ^ n)).mul_left_cancel hr, map_mul]
#align is_artinian_ring.localization_surjective IsArtinianRing.localization_surjective

theorem localization_artinian : IsArtinianRing L :=
  (localization_surjective S L).IsArtinianRing
#align is_artinian_ring.localization_artinian IsArtinianRing.localization_artinian

/-- `is_artinian_ring.localization_artinian` can't be made an instance, as it would make `S` + `R`
into metavariables. However, this is safe. -/
instance : IsArtinianRing (Localization S) :=
  localization_artinian S _

end Localization

end IsArtinianRing


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.big_operators.fin
import algebra.geom_sum
import linear_algebra.matrix.determinant
import linear_algebra.matrix.nondegenerate

/-!
# Vandermonde matrix

This file defines the `vandermonde` matrix and gives its determinant.

## Main definitions

 - `vandermonde v`: a square matrix with the `i, j`th entry equal to `v i ^ j`.

## Main results

 - `det_vandermonde`: `det (vandermonde v)` is the product of `v i - v j`, where
   `(i, j)` ranges over the unordered pairs.
-/

variables {R : Type*} [comm_ring R]

open equiv finset
open_locale big_operators matrix

namespace matrix

/-- `vandermonde v` is the square matrix with `i`th row equal to `1, v i, v i ^ 2, v i ^ 3, ...`.
-/
def vandermonde {n : ℕ} (v : fin n → R) : matrix (fin n) (fin n) R :=
λ i j, v i ^ (j : ℕ)

@[simp] lemma vandermonde_apply {n : ℕ} (v : fin n → R) (i j) :
  vandermonde v i j = v i ^ (j : ℕ) :=
rfl

@[simp] lemma vandermonde_cons {n : ℕ} (v0 : R) (v : fin n → R) :
  vandermonde (fin.cons v0 v : fin n.succ → R) =
    fin.cons (λ j, v0 ^ (j : ℕ)) (λ i, fin.cons 1 (λ j, v i * vandermonde v i j)) :=
begin
  ext i j,
  refine fin.cases (by simp) (λ i, _) i,
  refine fin.cases (by simp) (λ j, _) j,
  simp [pow_succ]
end

lemma vandermonde_succ {n : ℕ} (v : fin n.succ → R) :
  vandermonde v =
    fin.cons (λ j, v 0 ^ (j : ℕ))
      (λ i, fin.cons 1 (λ j, v i.succ * vandermonde (fin.tail v) i j)) :=
begin
  conv_lhs { rw [← fin.cons_self_tail v, vandermonde_cons] },
  simp only [fin.tail]
end

lemma vandermonde_mul_vandermonde_transpose {n : ℕ} (v w : fin n → R) (i j) :
  (vandermonde v ⬝ (vandermonde w)ᵀ) i j = ∑ (k : fin n), (v i * w j) ^ (k : ℕ) :=
by simp only [vandermonde_apply, matrix.mul_apply, matrix.transpose_apply, mul_pow]

lemma vandermonde_transpose_mul_vandermonde {n : ℕ} (v : fin n → R) (i j) :
  ((vandermonde v)ᵀ ⬝ vandermonde v) i j = ∑ (k : fin n), v k ^ (i + j : ℕ) :=
by simp only [vandermonde_apply, matrix.mul_apply, matrix.transpose_apply, pow_add]

lemma det_vandermonde {n : ℕ} (v : fin n → R) :
  det (vandermonde v) = ∏ i : fin n, ∏ j in Ioi i, (v j - v i) :=
begin
  unfold vandermonde,

  induction n with n ih,
  { exact det_eq_one_of_card_eq_zero (fintype.card_fin 0) },

  calc det (of $ λ (i j : fin n.succ), v i ^ (j : ℕ))
      = det (of $ λ (i j : fin n.succ), matrix.vec_cons
               (v 0 ^ (j : ℕ))
               (λ i, v (fin.succ i) ^ (j : ℕ) - v 0 ^ (j : ℕ)) i) :
    det_eq_of_forall_row_eq_smul_add_const (matrix.vec_cons 0 1) 0 (fin.cons_zero _ _) _
  ... = det (of $ λ (i j : fin n), matrix.vec_cons
               (v 0 ^ (j.succ : ℕ))
               (λ (i : fin n), v (fin.succ i) ^ (j.succ : ℕ) - v 0 ^ (j.succ : ℕ))
               (fin.succ_above 0 i)) :
    by simp_rw [det_succ_column_zero, fin.sum_univ_succ, of_apply, matrix.cons_val_zero, submatrix,
                of_apply, matrix.cons_val_succ,
                fin.coe_zero, pow_zero, one_mul, sub_self, mul_zero, zero_mul,
                finset.sum_const_zero, add_zero]
  ... = det (of $ λ (i j : fin n), (v (fin.succ i) - v 0) *
              (∑ k in finset.range (j + 1 : ℕ), v i.succ ^ k * v 0 ^ (j - k : ℕ)) :
                matrix _ _ R) :
    by { congr, ext i j, rw [fin.succ_above_zero, matrix.cons_val_succ, fin.coe_succ, mul_comm],
         exact (geom_sum₂_mul (v i.succ) (v 0) (j + 1 : ℕ)).symm }
  ... = (∏ (i : fin n), (v (fin.succ i) - v 0)) * det (λ (i j : fin n),
    (∑ k in finset.range (j + 1 : ℕ), v i.succ ^ k * v 0 ^ (j - k : ℕ))) :
    det_mul_column (λ i, v (fin.succ i) - v 0) _
  ... = (∏ (i : fin n), (v (fin.succ i) - v 0)) * det (λ (i j : fin n), v (fin.succ i) ^ (j : ℕ)) :
    congr_arg ((*) _) _
  ... = ∏ i : fin n.succ, ∏ j in Ioi i, (v j - v i) :
    by simp_rw [ih (v ∘ fin.succ), fin.prod_univ_succ, fin.prod_Ioi_zero, fin.prod_Ioi_succ],
  { intros i j,
    simp_rw [of_apply],
    rw matrix.cons_val_zero,
    refine fin.cases _ (λ i, _) i,
    { simp },
    rw [matrix.cons_val_succ, matrix.cons_val_succ, pi.one_apply],
    ring },
  { cases n,
    { simp only [det_eq_one_of_card_eq_zero (fintype.card_fin 0)] },
    apply det_eq_of_forall_col_eq_smul_add_pred (λ i, v 0),
    { intro j,
      simp },
    { intros i j,
      simp only [smul_eq_mul, pi.add_apply, fin.coe_succ, fin.coe_cast_succ, pi.smul_apply],
      rw [finset.sum_range_succ, add_comm, tsub_self, pow_zero, mul_one, finset.mul_sum],
      congr' 1,
      refine finset.sum_congr rfl (λ i' hi', _),
      rw [mul_left_comm (v 0), nat.succ_sub, pow_succ],
      exact nat.lt_succ_iff.mp (finset.mem_range.mp hi') } }
end

lemma det_vandermonde_eq_zero_iff [is_domain R] {n : ℕ} {v : fin n → R} :
  det (vandermonde v) = 0 ↔ ∃ (i j : fin n), v i = v j ∧ i ≠ j :=
begin
  split,
  { simp only [det_vandermonde v, finset.prod_eq_zero_iff, sub_eq_zero, forall_exists_index],
    exact λ i _ j h₁ h₂, ⟨j, i, h₂, (mem_Ioi.mp h₁).ne'⟩ },
  { simp only [ne.def, forall_exists_index, and_imp],
    refine λ i j h₁ h₂, matrix.det_zero_of_row_eq h₂ (funext $ λ k, _),
    rw [vandermonde_apply, vandermonde_apply, h₁], }
end

lemma det_vandermonde_ne_zero_iff [is_domain R] {n : ℕ} {v : fin n → R} :
  det (vandermonde v) ≠ 0 ↔ function.injective v :=
by simpa only [det_vandermonde_eq_zero_iff, ne.def, not_exists, not_and, not_not]

theorem eq_zero_of_forall_index_sum_pow_mul_eq_zero {R : Type*} [comm_ring R]
  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
  (hfv : ∀ j, ∑ i : fin n, (f j ^ (i : ℕ)) * v i = 0) : v = 0 :=
eq_zero_of_mul_vec_eq_zero (det_vandermonde_ne_zero_iff.mpr hf) (funext hfv)

theorem eq_zero_of_forall_index_sum_mul_pow_eq_zero {R : Type*} [comm_ring R]
  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
  (hfv : ∀ j, ∑ i, v i * (f j ^ (i : ℕ)) = 0) : v = 0 :=
by { apply eq_zero_of_forall_index_sum_pow_mul_eq_zero hf, simp_rw mul_comm, exact hfv }

theorem eq_zero_of_forall_pow_sum_mul_pow_eq_zero {R : Type*} [comm_ring R]
  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
  (hfv : ∀ i : fin n, ∑ j : fin n, v j * (f j ^ (i : ℕ)) = 0) : v = 0 :=
eq_zero_of_vec_mul_eq_zero (det_vandermonde_ne_zero_iff.mpr hf) (funext hfv)

end matrix


lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin
induction c with h hd,
repeat {rw mul_zero},
rw mul_succ,
rw mul_succ,
rwa [hd, mul_add],
end


import algebra.category.Group.abelian
import algebra.category.Group.filtered_colimits
import category_theory.limits.concrete_category
import for_mathlib.AddCommGroup.exact
import for_mathlib.ab5

.

open category_theory

namespace AddCommGroup

universes u

variables {J : Type u} [small_category J] [is_filtered J]

noncomputable theory

-- Axiom AB5 for `AddCommGroup`
theorem exact_colim_of_exact_of_is_filtered
  (F G H : J ⥤ AddCommGroup.{u}) (η : F ⟶ G) (γ : G ⟶ H) :
  (∀ j, exact (η.app j) (γ.app j)) → exact (limits.colim_map η) (limits.colim_map γ) :=
begin
  intros h,
  rw AddCommGroup.exact_iff', split,
  { ext1 j, simp [reassoc_of (h j).1] },
  { rintros x (hx : _ = _),
    obtain ⟨j,y,rfl⟩ := limits.concrete.colimit_exists_rep _ x,
    erw [← comp_apply, limits.colimit.ι_desc] at hx, dsimp at hx,
    rw comp_apply at hx,
    have : (0 : limits.colimit H) = limits.colimit.ι H j 0, by simp, rw this at hx, clear this,
    obtain ⟨k,e₁,e₂,hk⟩ := limits.concrete.colimit_exists_of_rep_eq _ _ _ hx,
    simp only [map_zero, ← comp_apply, ← nat_trans.naturality] at hk, rw comp_apply at hk,
    obtain ⟨t,ht⟩ := ((AddCommGroup.exact_iff' _ _).1 (h k)).2 hk,
    use limits.colimit.ι F k t,
    erw [← comp_apply, limits.colimit.ι_map, comp_apply, ht, ← comp_apply],
    congr' 1, simp }
end

instance AB5 : AB5 AddCommGroup.{u} :=
begin
  constructor, introsI J _ _, intros F G H f g h,
  apply exact_colim_of_exact_of_is_filtered,
  exact (nat_trans.exact_iff_forall.{(u+1) u u} f g).1 h,
end

end AddCommGroup


import order.lattice_intervals
import order.rel_iso

universes u v
open function set

section intervals

variables {α : Type u} {a b : α}

namespace Icc

instance distrib_lattice [distrib_lattice α] : distrib_lattice (Icc a b) :=
{ le_sup_inf := λ x y z, subtype.mk_le_mk.mpr (distrib_lattice.le_sup_inf x y z) , .. Icc.lattice }

@[reducible] def boolean_algebra [boolean_algebra α] {a b : α} (hab : a ≤ b) :
  boolean_algebra (Icc a b) :=
{ compl := λ x, ⟨a ⊔ (xᶜ ⊓ b), ⟨le_sup_left, sup_le hab inf_le_right⟩⟩,
  sdiff := λ x y, x ⊓ ⟨a ⊔ (yᶜ ⊓ b), ⟨le_sup_left, sup_le hab inf_le_right⟩⟩,
  sdiff_eq := λ x y, rfl,
  bot := ⟨a, ⟨rfl.le, hab⟩⟩,
  sup_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : x ⊓ y ⊔ (x ⊓ (a ⊔ (yᶜ ⊓ b))) = x, from subtype.mk_eq_mk.mpr h,
    rw [←inf_sup_left, sup_inf_left, @sup_comm α _ a, sup_inf_left, ←sup_assoc, ←sup_assoc],
    simp only [sup_compl_eq_top, top_sup_eq, top_inf_eq, inf_eq_left],
    exact hx.2.trans le_sup_right,
  end,
  inf_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : (x : α) ⊓ y ⊓ (x ⊓ (a ⊔ (yᶜ ⊓ b))) = a, from subtype.mk_eq_mk.mpr h,
    rw [inf_right_comm, ←inf_assoc, inf_idem],
    refine le_antisymm _ (le_inf (le_inf hx.1 (le_sup_left)) hy.1),
    rw [inf_assoc, inf_sup_right, inf_right_comm, compl_inf_eq_bot, bot_inf_eq, sup_bot_eq,
      inf_left_comm],
    exact inf_le_left,
  end,
  top := ⟨b, ⟨hab, rfl.le⟩⟩,
  inf_compl_le_bot :=
  begin
    intro x,
    suffices h : (x : α) ⊓ (a ⊔ (xᶜ ⊓ b)) ≤ a, from subtype.mk_le_mk.mpr h,
    simp [inf_sup_left, ←inf_assoc],
  end,
  top_le_sup_compl :=
  begin
    intro x,
    suffices h : b ≤ x ⊔ (a ⊔ (xᶜ ⊓ b)), from subtype.mk_le_mk.mpr h,
    simp only [sup_compl_eq_top, @sup_comm _ _ a, sup_inf_left, top_sup_eq, top_inf_eq, ←sup_assoc,
    sup_right_comm],
    exact le_sup_right,
  end,
  le_top := λ a, a.2.2,
  bot_le := λ a, a.2.1,
  le_sup_inf := λ x y z, subtype.mk_le_mk.mpr (boolean_algebra.le_sup_inf x y z),
  ..Icc.lattice,
  ..Icc.bounded_order hab, }

end Icc

namespace Ici

instance distrib_lattice [distrib_lattice α] : distrib_lattice (Ici a) :=
{ le_sup_inf := λ x y z, subtype.mk_le_mk.mpr (distrib_lattice.le_sup_inf x y z), .. Ici.lattice }

instance boolean_algebra [boolean_algebra α] : boolean_algebra (Ici a) :=
{ compl := λ x, ⟨a ⊔ xᶜ, (le_sup_left : a ≤ a ⊔ xᶜ)⟩,
  sdiff := λ x y, x ⊓ ⟨a ⊔ yᶜ, (le_sup_left : a ≤ a ⊔ yᶜ)⟩,
  sdiff_eq := λ x y, rfl,
  bot := ⟨a, rfl.le⟩,
  top := ⟨⊤, le_top⟩,
  sup_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : x ⊓ y ⊔ (x ⊓ (a ⊔ yᶜ)) = x, from subtype.mk_eq_mk.mpr h,
    simp [←inf_sup_left, sup_left_comm],
  end,
  inf_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : x ⊓ y ⊓ (x ⊓ (a ⊔ yᶜ)) = a, from subtype.mk_eq_mk.mpr h,
    rw [inf_right_comm, ←inf_assoc, inf_idem, inf_assoc, inf_sup_right, compl_inf_eq_bot,
      sup_bot_eq, inf_eq_left.mpr hy, inf_eq_right.mpr hx],
  end,
  inf_compl_le_bot :=
  begin
    rintro ⟨x,hx⟩,
    suffices h : (x : α) ⊓ (a ⊔ xᶜ) ≤ a, from subtype.mk_le_mk.mpr h,
    simp [inf_sup_left],
  end,
  top_le_sup_compl :=
  begin
    rintro ⟨x,hx⟩,
    suffices h : ⊤ ≤ x ⊔ (a ⊔ xᶜ), from subtype.mk_le_mk.mpr h,
    simp [sup_left_comm],
  end,
  le_top := by {rintros ⟨x,hx⟩, exact subtype.mk_le_mk.mpr (boolean_algebra.le_top _)},
  bot_le := by {rintros ⟨x,hx⟩, exact subtype.mk_le_mk.mpr hx},
  le_sup_inf := by {rintros ⟨x,hx⟩ ⟨y,hy⟩ ⟨z,hz⟩, exact subtype.mk_le_mk.mpr
    (boolean_algebra.le_sup_inf x y z),},
  ..Ici.lattice,
  ..Ici.bounded_order, }
end Ici

namespace Iic

instance distrib_lattice [distrib_lattice α] {a : α} : distrib_lattice (Iic a) :=
{ le_sup_inf := λ x y z, subtype.mk_le_mk.mpr (distrib_lattice.le_sup_inf x y z), .. Iic.lattice }

instance boolean_algebra [boolean_algebra α] {a : α} : boolean_algebra (Iic a) :=
{ compl := λ x, ⟨a ⊓ xᶜ, (inf_le_left)⟩,
  sdiff := λ x y, x ⊓ ⟨a ⊓ yᶜ, (inf_le_left)⟩,
  sdiff_eq := λ x y, rfl,
  bot := ⟨⊥, bot_le⟩,
  top := ⟨a, rfl.le⟩,
  sup_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : x ⊓ y ⊔ (x ⊓ (a ⊓ yᶜ)) = x, from subtype.mk_eq_mk.mpr h,
    rw [←inf_sup_left, inf_eq_left, sup_inf_left, sup_compl_eq_top, inf_top_eq],
    exact le_trans hx (le_sup_right),
  end,
  inf_inf_sdiff :=
  begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩,
    suffices h : x ⊓ y ⊓ (x ⊓ (a ⊓ yᶜ)) = ⊥, from subtype.mk_eq_mk.mpr h,
    rw [inf_right_comm, ←inf_assoc, inf_idem, inf_assoc, inf_assoc, compl_inf_eq_bot, inf_bot_eq,
    inf_bot_eq],
  end,
  inf_compl_le_bot :=
  begin
    rintro ⟨x,hx⟩,
    suffices h : (x : α) ⊓ (a ⊓ xᶜ) ≤ ⊥, from subtype.mk_le_mk.mpr h,
    simp [inf_left_comm],
  end,
  top_le_sup_compl :=
  begin
    rintro ⟨x,hx⟩,
    suffices h : a ≤ x ⊔ (a ⊓ xᶜ), from subtype.mk_le_mk.mpr h,
    simp [sup_inf_left],
  end,
  le_top := by {rintros ⟨x,hx⟩, exact subtype.mk_le_mk.mpr hx},
  bot_le := by {rintros ⟨x,hx⟩, exact subtype.mk_le_mk.mpr (boolean_algebra.bot_le x), },
  le_sup_inf := by {rintros ⟨x,hx⟩ ⟨y,hy⟩ ⟨z,hz⟩, exact subtype.mk_le_mk.mpr
    (boolean_algebra.le_sup_inf x y z),},
  ..Iic.lattice,
  ..Iic.bounded_order, }

end Iic

section iso

variables [boolean_algebra α]

lemma inf_compl_sup_compl_inf_sup_eq_self {x a b : α} (hax : a ≤ x) (hxb : x ≤ b) :
  (x ⊓ a ᶜ ⊔ bᶜ) ⊓ b ⊔ a = x :=
by rw [inf_sup_right, compl_inf_eq_bot, sup_bot_eq, sup_inf_right, sup_inf_right, compl_sup_eq_top,
  inf_top_eq, ←sup_inf_right, inf_eq_left.mpr hxb, sup_eq_left.mpr hax]

/-- A canonical order isomorphism between `Icc a b` and `Icc bᶜ aᶜ` with respect to the primal
  ordering `≤` in a boolean algebra as opposed to the dual  --/
@[simps apply]
def Icc_Icc_compl_iso (a b : α) :
  (Icc a b) ≃o (Icc bᶜ aᶜ)  :=

{ to_fun := λ x, ⟨x ⊓ aᶜ ⊔ bᶜ,
  ⟨le_sup_right, sup_le_iff.mpr ⟨inf_le_right, compl_le_compl (x.2.1.trans x.2.2)⟩⟩⟩,
  inv_fun := λ x, ⟨x ⊓ b ⊔ a, ⟨le_sup_right,
    sup_le_iff.mpr ⟨inf_le_right, (compl_le_compl_iff_le.mp (x.2.1.trans x.2.2))⟩⟩⟩,
  left_inv := by {rintro ⟨x,hx⟩, simp only [subtype.coe_mk, subtype.mk_eq_mk,
    inf_compl_sup_compl_inf_sup_eq_self hx.1 hx.2]},
  right_inv := by {rintro ⟨x,hx⟩, simp only [subtype.coe_mk, subtype.mk_eq_mk],
    convert inf_compl_sup_compl_inf_sup_eq_self hx.1 hx.2; simp},
  map_rel_iff' :=
  begin
    rintros ⟨x,⟨hax,hxb⟩⟩ ⟨y,⟨hay,hyb⟩⟩,
    simp only [le_sup_right, sup_le_iff, subtype.coe_mk, equiv.coe_fn_mk, subtype.mk_le_mk,
      and_true],
    rw [sup_inf_right, ←compl_inf, inf_eq_left.mpr (hax.trans hxb)],
    refine ⟨λ h, _, λ h, inf_le_inf_right _ (le_sup_of_le_left h)⟩,
    rw [←sup_inf_sdiff x a, inf_eq_right.mpr hax, sdiff_eq],
    refine sup_le hay ((le_inf (inf_le_of_left_le hxb) h).trans _),
    rw [inf_left_comm, ←inf_assoc, inf_sup_right, compl_inf_eq_bot, sup_bot_eq, inf_assoc],
    exact inf_le_left,
  end  }

@[simps apply]
def Icc_Icc_compl_iso' (a b : α) :
  (Icc a bᶜ) ≃o (Icc b aᶜ)  :=
(Icc_Icc_compl_iso a bᶜ).trans (order_iso.set_congr (Icc bᶜᶜ aᶜ) (Icc b aᶜ) (by rw compl_compl))

--@[simps apply]
def Iic_Ici_compl_iso (a : α):
  Iic a ≃o Ici aᶜ :=
(order_iso.set_congr (Iic a) (Icc ⊥ a) Icc_bot.symm).trans
  ((Icc_Icc_compl_iso ⊥ a).trans
    (order_iso.set_congr (Icc aᶜ ⊥ᶜ) (Ici aᶜ) (by rw [compl_bot, Icc_top])))

-- @[simp] lemma Iic_Ici_compl_iso_apply (a : α) (x : ↥(Iic a)) :
--   (Iic_Ici_compl_iso a) x = ⟨x ⊔ aᶜ, by {sorry }⟩ :=
-- begin
--   by simp [Iic_Ici_compl_iso],
-- end

end iso

end intervals

-- section iso_image

-- variables {α : Type u} {β : Type v} [has_le β]

-- def order_iso.image_semilattice_sup [semilattice_sup α] (φ : α ≃o β) : semilattice_sup β :=
-- { sup := λ x y, φ (φ.symm x ⊔ φ.symm y),
--   le := λ x y, φ.symm x ≤ φ.symm y,
--   lt := λ x y, φ.symm x < φ.symm y,
--   le_refl := λ x, rfl.le,
--   le_trans := λ _ _ _, le_trans,
--   lt_iff_le_not_le := λ x y, lt_iff_le_not_le,
--   le_antisymm := λ x y hxy hyx, φ.symm.injective (le_antisymm hxy hyx),
--   le_sup_left := λ x y, (order_iso.symm_apply_apply φ _).symm.subst le_sup_left,
--   le_sup_right := λ x y, (order_iso.symm_apply_apply φ _).symm.subst le_sup_right,
--   sup_le := λ x y z hxy hyz, by {rw ←order_iso.map_sup,   }  }

-- def order_iso.boolean_algebra {α : Type u} {β : Type v} [boolean_algebra α] [has_le β] (φ : α ≃o β) :
--   boolean_algebra β := {

--   sup_le := λ x y z, by {
--     sorry,
--   },
--   inf := sorry,
--   inf_le_left := sorry,
--   inf_le_right := sorry,
--   le_inf := sorry,
--   le_sup_inf := sorry,
--   sdiff := sorry,
--   bot := sorry,
--   sup_inf_sdiff := sorry,
--   inf_inf_sdiff := sorry,
--   compl := sorry,
--   top := sorry,
--   inf_compl_le_bot := sorry,
--   top_le_sup_compl := sorry,
--   le_top := sorry,
--   bot_le := sorry,
--   sdiff_eq := sorry }
-- --instance boolean_algebra [boolean_algebra α] {a : α} : boolean_algebra (Ici a)

-- end iso_image


import data.set.basic

import topology.basic
import algebra.module.basic
import algebra.module.submodule

import analysis.normed_space.basic

-- On désigne par p1 et p2 les applications coordonnées de R 2 définies par pi (x1 , x2 ) = xi.
-- (a) Soit O un ouvert de R 2 , montrer que p 1 (O) et p 2 (O) sont des ouverts de R.
-- (b) Soit H = (x, y) ∈ R 2 xy = 1. Montrer que H est un fermé de R 2 et que p 1 (H) et p 2 (H) ne sont pas des fermés de R .
-- (c) Montrer que si F est fermé et que p2 (F) est borné, alors p1 (F) est fermé.

theorem c:
  forall f: set (real × real), is_closed f -> metric.bounded (prod.snd '' f) -> is_closed (prod.fst '' f)
:= sorry