/-
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.group_action.quotient
import group_theory.perm.sign
import group_theory.perm.subgroup
import linear_algebra.linear_independent
import linear_algebra.multilinear.basis
import linear_algebra.multilinear.tensor_product

/-!
# 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*}

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 [decidable_eq ι] (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 [decidable_eq ι] (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 [decidable_eq ι] (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 [decidable_eq ι] (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 [decidable_eq ι] (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_smul

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

instance : has_smul 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

instance [distrib_mul_action Sᵐᵒᵖ N] [is_central_scalar S N] :
  is_central_scalar S (alternating_map R M N ι) :=
⟨λ c f, ext $ λ x, op_smul_eq_smul _ _⟩

end has_smul

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*} [decidable_eq ι] (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 [decidable_eq ι] {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 [decidable_eq ι] {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 [decidable_eq ι] {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 [decidable_eq ι] {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 [decidable_eq ι] {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 [decidable_eq ι] [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 [decidable_eq ι] [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 ι] [decidable_eq ι] (σ : 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,
  letI := classical.dec_eq ι,
  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 ι] [decidable_eq ι]

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 [decidable_eq ι] [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'₂] [decidable_eq ι] [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*}[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_smul.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
variables [decidable_eq ιa] [decidable_eq ιb]

/-- 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 σ)
  (λ σ₁ σ₂ H, begin
    rw quotient_group.left_rel_apply at H,
    obtain ⟨⟨sl, sr⟩, h⟩ := H,
    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σ,
  cases hi : σ⁻¹ i;
    cases hj : σ⁻¹ j;
    rw perm.inv_eq_iff_eq at hi hj;
  substs hi hj; revert val val_1,
  case [sum.inl sum.inr, sum.inr sum.inl]
  { -- the term pairs with and cancels another term
    all_goals {
      intros i' j' hv hij hσ,
      obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient_group.left_rel_apply.mp (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, sum.inl sum.inl]
  { -- the term does not pair but is zero
    all_goals {
      intros i' j' hv hij hσ,
      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
`linear_map.mul'`.
-/
@[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 :=
rfl

end alternating_map

open equiv

/-- A helper lemma for `multilinear_map.dom_coprod_alternization`. -/
lemma multilinear_map.dom_coprod_alternization_coe [decidable_eq ιa] [decidable_eq ιb]
  (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 [decidable_eq ιa] [decidable_eq ιb]
  (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_group.eq' },

  -- eliminate a multiplication
  rw [← finset.map_univ_equiv (equiv.mul_left σ), finset.filter_map, finset.sum_map],
  simp_rw [equiv.coe_to_embedding, equiv.coe_mul_left, (∘), mul_inv_rev, inv_mul_cancel_right,
    subgroup.inv_mem_iff, monoid_hom.mem_range, finset.univ_filter_exists,
    finset.sum_image (perm.sum_congr_hom_injective.inj_on _)],

  -- 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 [decidable_eq ιa] [decidable_eq ιb]
  (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*} [finite ι]
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
  classical,
  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


import .finite .heq

section
parameters {R : Type _} [semiring R]

def sum_over : Π {n} (f : fin n → R), R
| 0     f := 0
| (n+1) f := sum_over (fin.restrict f) + f ⟨n, nat.lt_succ_self n⟩

lemma sum_over.step {n} (f : fin (nat.succ n) → R)
  : sum_over f = sum_over (fin.restrict f) + f ⟨n, nat.lt_succ_self n⟩
  := rfl

lemma sum_over.step_front {n} (f : fin (nat.succ n) → R)
  : sum_over f = f  ⟨0, nat.zero_lt_succ n⟩ + sum_over (λ j : fin n, f ⟨nat.succ j.val, nat.succ_lt_succ j.is_lt⟩) :=
begin
  induction n with n ih, simp [sum_over],
  rw [sum_over.step, ih (fin.restrict f)],
  rw add_assoc, congr
end

lemma sum_over_split (n m) :
  ∀ (f : fin (n + m) → R),
    sum_over f =
    sum_over (fin.restrict_many n m f) + sum_over (fin.tail n m f) :=
begin
  induction m; intro f;
  simp [fin.restrict_many, fin.tail, sum_over],
  { congr, funext, congr, apply fin.eq_of_veq, refl },
  case nat.succ : m ih {
    rw [add_comm (f ⟨n+m, _⟩), ← add_assoc],
    congr, apply ih }
end

lemma sum_over_eq_zero {n} : @sum_over n (λ _, 0) = 0 :=
by { induction n, refl, dsimp [sum_over], rw add_zero, apply n_ih }

lemma sum_over_omit {n} (f : fin (nat.succ n) → R)
  : ∀ k : fin (nat.succ n),
    sum_over f = sum_over (fin.fun_omit k.val f) + f k :=
begin
  revert f, induction n; intros f k,
  { dsimp [sum_over], congr, apply fin.eq_of_veq,
    symmetry, apply nat.eq_zero_of_le_zero,
    exact nat.le_of_succ_le_succ k.is_lt },
  case nat.succ : n ih {
    cases (_ : k.val < nat.succ n ∨ k.val = nat.succ n),
    { rw sum_over.step, rw ih _ ⟨k.val, h⟩,
      dsimp [sum_over], rw [add_assoc, add_assoc, add_comm (fin.restrict _ _)],
      congr, dsimp [fin.fun_omit], rw [dif_neg _],
      intro h', apply nat.not_self_lt_lt_succ_self h' h,
      simp [fin.restrict], congr, apply fin.eq_of_veq, refl },
    { rw h, rw (_ : f k = f ⟨nat.succ n, nat.lt_succ_self _⟩),
      dsimp [sum_over], congr, apply restrict_is_omit_n,
      rw restrict_is_omit_n, congr, apply fin.eq_of_veq, exact h },
    apply or.resolve_right, rw or_assoc,
    exact nat.lt_trichotomy k.val (nat.succ n),
    intro h', apply nat.not_self_lt_lt_succ_self h' k.is_lt }
end

lemma sum_over_nonzero {n} (f : fin n → R)
  : ∀ {m} (g : fin m → R),
    (∀ x y, f x ≠ 0 → f x = f y → x = y)
    → function.injective g
    → fun.im g = { x ∈ fun.im f | x ≠ 0 }
    → sum_over f = sum_over g :=
begin
  induction n; intros m g f_i g_i h,
  { intros, cases m, simp [sum_over],
    let k : fin m.succ := ⟨0, nat.zero_lt_succ m⟩,
    have : g k ∈ fun.im g := ⟨k, rfl⟩,
    rw h at this, cases this.left, exact w.elim0 },
  case nat.succ : n ih {
    dsimp [sum_over],
    cases classical.prop_decidable (f ⟨n, nat.lt_succ_self n⟩ = 0),
    tactic.swap,
    { rw h_1, rw add_zero, apply ih (fin.restrict f) g _ g_i, rw h,
      funext, apply propext, constructor; intro hx;
      refine and.intro _ hx.right; cases hx.left with k hk,
      { have : k.val < n,
        { cases (nat.lt_trichotomy k.val n), assumption,
          { exfalso, cases h_2,
            { apply hx.right, rw ← hk,
              rw ← h_1, congr, apply fin.eq_of_veq,
              assumption },
            { apply nat.not_self_lt_lt_succ_self h_2 k.is_lt } } },
        existsi fin.mk k.val this,
        dsimp [fin.restrict], rw ← hk,
        congr, apply fin.eq_of_veq, refl },
      { existsi (fin.mk k.val (lt_trans k.is_lt $ nat.lt_succ_self n)),
        rw ← hk, refl },
      { dsimp [fin.restrict], intros, apply fin.eq_of_veq,
        apply @fin.veq_of_eq (nat.succ n) ⟨x.val, nat.lt_trans x.is_lt (nat.lt_succ_self n)⟩
                                          ⟨y.val, nat.lt_trans y.is_lt (nat.lt_succ_self n)⟩,
        apply f_i; assumption } },
    { have : f ⟨n, nat.lt_succ_self n⟩ ∈ fun.im g,
      { rw h, refine and.intro _ h_1,
        existsi fin.mk n (nat.lt_succ_self n), refl },
      cases this with k hk, cases m, { exact k.elim0 },
      rw sum_over_omit g k, apply congr,
      rw ih _ (fin.fun_omit k.val g),
      { dsimp [fin.restrict], intros, apply fin.eq_of_veq,
        apply @fin.veq_of_eq (nat.succ n) ⟨x.val, nat.lt_trans x.is_lt (nat.lt_succ_self n)⟩
                                          ⟨y.val, nat.lt_trans y.is_lt (nat.lt_succ_self n)⟩,
        apply f_i; assumption },
      { apply omit_inj_if_fun_inj, assumption },
      { rw im_omit _ _ _ g_i, rw hk,
        transitivity ({x : R | x ∈ fun.im f ∧ x ≠ 0} ∖ { f ⟨n, nat.lt_succ_self n⟩ }),
        { rw h, refl },
        { rw elem_singleton, funext x, apply propext,
          constructor; intro h'; cases h',
          { constructor, cases h'_left.left,
            have : w.val < n,
            cases nat.lt_trichotomy w.val n, assumption,
            cases h_3, exfalso, apply h'_right,
            rw ← h_2, congr, apply fin.eq_of_veq, exact h_3,
            exfalso, apply nat.not_self_lt_lt_succ_self h_3 w.is_lt,
            existsi fin.mk w.val this, rw ← h_2,
            dsimp [fin.restrict], congr, apply fin.eq_of_veq,
            refl, exact h'_left.right },
          { constructor, constructor, cases h'_left,
            existsi fin.mk h'_left_w.val (nat.lt_trans h'_left_w.is_lt $ nat.lt_succ_self n),
            rw ← h'_left_h, dsimp [fin.restrict], congr,
            assumption, intro h', cases h'_left,
            apply nat.lt_irrefl n, rw (_ : n < n ↔ h'_left_w.val < n),
            exact h'_left_w.is_lt, rw (_ : h'_left_w.val = n),
            dsimp [fin.restrict] at h'_left_h h'_right,
            apply @fin.veq_of_eq (nat.succ n) ⟨h'_left_w.val, nat.lt_trans h'_left_w.is_lt (nat.lt_succ_self n)⟩
                                              ⟨n, nat.lt_succ_self n⟩,
            apply f_i, rw ← h'_left_h at h'_right,
            assumption, rw h'_left_h, assumption } } },
      { symmetry, assumption } } }
end

def sum_over_sum {n} : ∀ (f g : fin n → R),
  sum_over (λ k, f k + g k) = sum_over f + sum_over g :=
begin
  induction n; intros; simp [sum_over],
  rw [← add_assoc, add_comm],
  rw [← add_assoc (sum_over (fin.restrict f))],
  apply congr_fun (congr_arg _ $ n_ih _ _)
end

lemma sum_over_tail {n m} (h : fin n × fin (nat.succ m) → R)
  : sum_over
    (fin.tail (nat.mul n m) n
      (λ (p : fin (n * nat.succ m)),
        h (fin.line_to_square p)))
  = sum_over (λ k : fin n, h (k, ⟨m, nat.lt_succ_self m⟩)) :=
begin
  induction m,
  { congr, funext,
    cases k, dsimp [fin.tail, fin.line_to_square],
    congr; rw (_ : nat.mul n 0 + k_val = k_val),
    apply nat.mod_eq_of_lt k_is_lt, tactic.swap,
    apply nat.div_eq_of_lt k_is_lt,
    all_goals { simp [nat.mul] } },
  case nat.succ : m ih {
    dsimp [fin.tail, fin.line_to_square],
    congr, funext, congr,
    { apply fin.eq_of_veq,
      simp [nat.mul], transitivity k.val % n,
      apply mod_of_add_multiple, apply nat.mod_eq_of_lt k.is_lt },
    { rw nat.div_eq_of_lt_le, rw mul_comm, apply nat.le_add_right,
      suffices : n * m + n + k.val < n * m + n + n,
      { rw nat.mul_comm, assumption },
      apply nat.add_lt_add_left, exact k.is_lt } }
end
end

section same_embedding
universes u v

structure same_embedding {A B} (f g : A → B) :=
(f_inj : function.injective f)
(g_inj : function.injective g)
(f2g : ∀ a, ∃ a', f a = g a')
(g2f : ∀ a, ∃ a', g a = f a')

lemma same_embedding_from_ims_eq {A : Type u} {B : Type v}
  : ∀ (f g : A → B),
    function.injective f
    → function.injective g
    → fun.im f = fun.im g
    → same_embedding f g :=
begin
  suffices : ∀ f g : A → B,
    fun.im f = fun.im g → ∀ a, ∃ a', f a = g a',
  { intros, constructor,
    assumption, assumption,
    apply this, assumption,
    apply this, symmetry, assumption },
  intros f g h, intro a,
  have : f a ∈ fun.im f := ⟨a, rfl⟩,
  rw h at this, cases this with a' h,
  existsi a', symmetry, assumption
end

end same_embedding

section
parameters {R : Type _} [semiring R]

lemma sum_unique.helper {n} (k : fin (nat.succ n))
  : ∀ (f : fin (nat.succ n) → R), sum_over f = sum_over (fin.fun_omit k.val f) + f k :=
begin
  induction n,
  { intros, dsimp [sum_over],
    cases k, congr,
    have : k_val + 1 ≤ 1,
    { exact k_is_lt },
    have : k_val ≤ 0,
    { apply nat.le_of_succ_le_succ k_is_lt },
    symmetry, exact nat.eq_zero_of_le_zero this },
  case nat.succ : n ih {
    intros,
    cases (nat.lt_trichotomy k.val n.succ),
    { rw (_ : sum_over f = fin.restrict f ⟨k.val, h⟩ + sum_over (fin.fun_omit k.val (fin.restrict f)) + f ⟨nat.succ n, nat.lt_succ_self n.succ⟩),
        rw add_assoc, rw add_comm,
        apply congr,
        { apply congr_arg,
          simp [sum_over],
          rw (_ : fin.fun_omit (k.val) f ⟨n, _⟩ = f ⟨nat.succ n, _⟩),
          rw add_comm, congr,
          dsimp [fin.fun_omit],
          rw dif_neg, intro h',
          apply nat.not_self_lt_lt_succ_self h' h },
        { simp [fin.restrict], congr,
          apply fin.eq_of_veq, refl },
        { rw add_comm (fin.restrict _ _),
          rw ← ih ⟨k.val, h⟩, refl } },
      { cases h,
        { rw h, rw ← restrict_is_omit_n,
          rw (_ : f k = f ⟨nat.succ n, nat.lt_succ_self _⟩),
          refl, congr, apply fin.eq_of_veq, assumption },
        { exfalso, exact nat.not_self_lt_lt_succ_self h k.is_lt } } },
end

lemma sum_over_unique {n} : ∀ (f g : fin n → R), same_embedding f g → sum_over f = sum_over g :=
begin
  induction n,
  { intros, refl },
  case nat.succ : n ih {
    intros,
    cases a with f_inj g_inj f2g g2f,
    have : ∃ k (h : k < n+1), f ⟨n, nat.lt_succ_self n⟩ = g ⟨k, h⟩,
    { cases f2g ⟨n, nat.lt_succ_self n⟩,
      cases w,
      existsi w_val, existsi w_is_lt, assumption },
    cases this with k e, cases e with hlt h,
    let g' : fin n → R := @fin.fun_omit R n k g,
    let f' : fin n → R :=
        λ m, f ⟨m.val, nat.lt_trans m.is_lt $ nat.lt_succ_self n⟩,
    specialize ih f' g' _,
    { transitivity @sum_over _ _ n (λ k, f ⟨k.val,nat.lt_trans k.is_lt $ nat.lt_succ_self n⟩)
                 + f ⟨n, nat.lt_succ_self n⟩,
      refl, rw h, rw sum_unique.helper ⟨k, hlt⟩ g,
      congr, transitivity sum_over f',
      refl, transitivity sum_over g',
      assumption, congr },
    { constructor,
      { intros x y hxy,
        cases x, cases y,
        simp [f'] at hxy,
        simp [fin.val] at hxy,
        apply fin.eq_of_veq,
        have := f_inj hxy,
        have := fin.mk.inj this,
        assumption },
      { apply omit_inj_if_fun_inj, assumption },
      { intros m,
        cases f2g ⟨m.val, nat.lt_trans m.is_lt $ nat.lt_succ_self n⟩,
        dsimp [g'],
        by_cases h' : w.val = k,
        { exfalso, apply nat.lt_irrefl n,
          have h' := eq.symm h',
          subst h', clear h',
          have : g w = g ⟨w.val, hlt⟩,
          { congr, apply fin.eq_of_veq, refl },
          rw this at h_1, rw ← h_1 at h,
          rw (_ : n < n ↔ m.val < n),
          exact m.is_lt, rw (_ : m.val = n),
          symmetry, apply fin.mk.inj,
          apply f_inj, exact h, },
        { by_cases h'' : w.val < k,
          { existsi fin.mk w.val (nat.lt_of_lt_of_le h'' (nat.le_of_lt_succ hlt)),
            dsimp [fin.fun_omit],
            rw dif_pos h'', dsimp [f'],
            rw h_1, congr, apply fin.eq_of_veq, refl },
          { have h_2 : k < w.val,
            { cases lt_trichotomy k w.val,
              { exact h_2 },
              { exfalso, cases h_2,
                { apply h', symmetry, assumption },
                { apply h'', assumption } } },
            have h_3 : 0 < w.val,
            { apply nat.lt_of_le_of_lt,
              apply nat.zero_le, exact h_2 },
            existsi fin.mk (nat.pred w.val) _,
            { dsimp [fin.fun_omit],
              rw dif_neg _, simp [f'],
              rw h_1, congr, apply fin.eq_of_veq,
              simp [fin.val], rw nat.one_add,
              rw nat.succ_pred_eq_of_pos h_3,
              intro h_4, cases w.val, cases h_2,
              simp at h_4, cases nat.eq_or_lt_of_not_lt h'',
              { exact h' h_5 },
              { exact nat.le_lt_antisymm (nat.succ_le_of_lt h_4) h_5, } },
            apply nat.lt_of_succ_lt_succ,
            rw nat.succ_pred_eq_of_pos h_3,
            exact w.is_lt } } },
      { intro m, by_cases hmk : m.val < k,
        { cases g2f ⟨m.val, nat.lt_trans m.is_lt $ nat.lt_succ_self n⟩,
          have : w.val < n,
          { by_contra,
            have : w.val = n,
            { apply or.resolve_right,
              apply eq_or_lt_of_not_lt a,
              apply nat.le_lt_antisymm,
              apply nat.le_of_lt_succ,
              exact w.is_lt },
            have : f w = g ⟨k, hlt⟩,
            { rw ← h, congr, apply fin.eq_of_veq, exact this },
            rw ← h_1 at this,
            have : m.val = k,
            { apply fin.mk.inj, apply g_inj, assumption },
            apply nat.lt_le_antisymm, exact hmk,
            apply le_of_eq, symmetry, assumption },
          existsi fin.mk w.val this,
          dsimp [f', g'],
          dsimp [fin.fun_omit],
          rw dif_pos hmk, rw h_1,
          congr, apply fin.eq_of_veq, refl },
        { cases g2f ⟨m.val + 1, nat.succ_lt_succ m.is_lt⟩,
          existsi fin.mk w.val _,
          dsimp [g', f'],
          dsimp [fin.fun_omit],
          rw dif_neg hmk,
          rw h_1, congr, apply fin.eq_of_veq, refl,
          have : w.val < n,
          { by_contra,
            have : w.val = n,
            { apply or.resolve_right,
              apply eq_or_lt_of_not_lt a,
              apply nat.le_lt_antisymm,
              apply nat.le_of_lt_succ,
              exact w.is_lt },
            have : f w = g ⟨k, hlt⟩,
            { rw ← h, congr, apply fin.eq_of_veq, exact this },
            rw ← h_1 at this,
            have : m.val + 1 = k,
            { apply fin.mk.inj, apply g_inj, assumption },
            apply hmk, rw ← this, apply nat.lt_succ_self, },
          exact this } } } }
end

lemma sum_over_glue {n m : ℕ}
  : ∀ (f : fin n → R) (g  : fin m → R),
    sum_over (fin.glue f g) = (sum_over f) + (sum_over g) :=
begin
  induction m,
  { intros, rw (_ : sum_over g = 0),
    { rw add_zero (sum_over f), congr, funext,
      dunfold fin.glue, rw dif_pos _,
      congr, apply fin.eq_of_veq, refl,
      clear f g, cases k, simp, rw add_zero at k_is_lt,
      assumption }, refl },
  case nat.succ : m ih {
    intros,
    rw (_ : sum_over (fin.glue f g) = sum_over (fin.restrict $ fin.glue f g) + (fin.glue f g ⟨n+m, nat.lt_succ_self (n+m)⟩)),
    rw (_ : sum_over g = sum_over (fin.restrict g) + g ⟨m, nat.lt_succ_self m⟩),
    { rw ← add_assoc,
      apply congr, apply congr_arg,
      rw fin.restrict_glue_comm, apply ih,
      have h1 : ¬ (n + m < n),
      { intro h, apply nat.not_lt_zero m,
        rw [← add_zero n, add_assoc, zero_add] at h,
        apply nat.lt_of_add_lt_add_left h },
      dunfold fin.glue, rw [dif_neg h1],
      congr, apply nat.add_sub_cancel_left },
    all_goals {refl} }
end

end

lemma mul_sum_over_left {R : Type _} [semiring R]
  : ∀ {n} (f : fin n → R) a,
    a * sum_over f = sum_over (λ k, a * f k) :=
begin
  intros n, induction n; intros,
  { simp [sum_over] },
  case nat.succ : m ih {
    simp [sum_over],
    rw [left_distrib],
    congr, apply ih }
end

lemma mul_sum_over_right {R : Type _} [semiring R]
  : ∀ {n} (f : fin n → R) a,
    sum_over f * a = sum_over (λ k, f k * a) :=
begin
  intros n, induction n; intros,
  { simp [sum_over] },
  case nat.succ : m ih {
    simp [sum_over],
    rw [right_distrib],
    congr, apply ih }
end

lemma mul_sum_eq_double_sum {R : Type _} [ring R]
  : ∀ {n m} (f : fin n → R) (g : fin m → R),
    sum_over f * sum_over g
    = sum_over (λ i : fin n,
        sum_over (λ j : fin m,
          f i * g j)) :=
by { intros, rw mul_sum_over_right, congr, funext, rw mul_sum_over_left }

-- @[reducible]
-- lemma double_sum_over_subset_indices {R : Type _} [ring R] {n m}
--   (S : set (fin n × fin m)) [decidable_pred S] (f : fin n × fin m → R) : R :=
--   sum_over (λ j : fin n, sum_over (λ k : fin m,
--     if S (j, k) then f (j, k) else 0))

-- lemma double_sum_param {R : Type _} [ring R] {n m k}
--   (S : set (fin n × fin m)) [decidable_pred S]
--   (f : fin n × fin m → R) (p : fin k → fin n × fin m)
--   : function.injective p → S = fun.im p
--   → double_sum_over_subset_indices S f = sum_over (f ∘ p) :=
-- begin
--   tactic.unfreeze_local_instances,
--   revert S, induction k with k ih; intros S _inst_2 p_i p_s,
--   { dunfold double_sum_over_subset_indices,
--     transitivity (0 : R), transitivity sum_over (λ j : fin n, (0 : R)),
--     congr, funext, transitivity sum_over (λ k : fin m, (0 : R)), congr, funext,
--     by_cases S (j,k), { rw p_s at h, cases h, exact h_w.elim0 }, { rw if_neg h },
--     apply @sum_over_eq_zero _ _ m, apply @sum_over_eq_zero _ _ n,
--     rw ← sum_over_eq_zero, congr, funext x, apply x.elim0 },
--   rw [sum_over.step, (_ : fin.restrict (f ∘ p) = f ∘ fin.restrict p)],
--   have : decidable_pred { y | S y ∧ y ≠ p ⟨k, nat.lt_succ_self k⟩ },
--   { intros y, by_cases y = p ⟨k, nat.lt_succ_self k⟩,
--     { apply is_false, intro h', exact h'.right h },
--     by_cases h' : S y, exact is_true (and.intro h' h),
--     apply is_false, intro h, exact h' h.left },
--   rw ← @ih (fin.restrict p) { y | S y ∧ y ≠ p ⟨k, nat.lt_succ_self k⟩ } this,
--   dunfold double_sum_over_subset_indices,
--   --cases n with n, { exact (p ⟨k, nat.lt_succ_self k⟩).fst.elim0 },
--   --cases m with m, { exact (p ⟨k, nat.lt_succ_self k⟩).snd.elim0 },
--   { have : (f ∘ p) ⟨k, nat.lt_succ_self k⟩
--          = sum_over (λ j : fin n, if j = prod.fst (p ⟨k, nat.lt_succ_self k⟩)
--                                   then (f ∘ p) ⟨k, nat.lt_succ_self k⟩
--                                   else 0),
--     { clear _inst_2 p_s this S ih,
--       induction n with n ih,
--       { apply fin.elim0, apply prod.fst ∘ p, exact ⟨k, nat.lt_succ_self k⟩ },
--       rw sum_over.step, by_cases fin.mk n (nat.lt_succ_self n) = (p ⟨k, nat.lt_succ_self k⟩).fst,
--       { rw if_pos h, transitivity 0 + (f ∘ p) ⟨k, nat.lt_succ_self k⟩, rw zero_add,
--         congr, rw ← @sum_over_eq_zero _ _ n, congr, funext j,
--         simp [fin.restrict], rw ← h, rw if_neg,
--         rw sum_over_eq_zero, intro h, apply ne_of_lt j.is_lt, apply fin.veq_of_eq h },
--       { rw if_neg h, let p' := fin.restrict p,

--         } } }
-- end

/-

    *               *
   **     *         *
  *** =  ** ∪     ∪ * ∪
 ****   ***         *
*****        ****       *

   *              *
  **    *         *
 *** = ** ∪     ∪ *
****        ***   *

Triangle(n+2) = Triangle(n) shifted up and right
              ∪ HorizontalLine(n)
              ∪ VerticalLine(n+1)
-/

lemma double_sum_triangle.helper1 {R :  Type _} [ring R]
  : ∀ {n : nat} (f : fin n.succ.succ → fin n.succ.succ → R),
    sum_over (λ i : fin n.succ.succ, sum_over (λ j : fin i.val.succ, f i ⟨j.val, lt_of_lt_of_le j.is_lt i.is_lt⟩))
  = sum_over (λ i : fin n.succ, sum_over (λ j : fin i.val,
    f ⟨i.val, nat.lt_trans i.is_lt (nat.lt_succ_self _)⟩
      ⟨j.val+1, nat.succ_lt_succ (lt_trans j.is_lt i.is_lt)⟩))
  + sum_over (λ i : fin n.succ, f ⟨i.val, lt_trans i.is_lt $ nat.lt_succ_self _⟩ ⟨0, nat.zero_lt_succ n.succ⟩)
  + sum_over (λ j : fin n.succ.succ, f ⟨n.succ, nat.lt_succ_self _⟩ ⟨j.val, j.is_lt⟩) :=
begin
  intros, rw [sum_over.step], dsimp [fin.restrict], congr,
  transitivity
  sum_over (λ (k : fin (nat.succ n)),
            f ⟨k.val, lt_trans k.is_lt (nat.lt_succ_self _)⟩
              ⟨0, nat.zero_lt_succ _⟩ +
            sum_over (λ (j : fin (k.val)),
                      f ⟨k.val, lt_trans k.is_lt (nat.lt_succ_self _)⟩
                        ⟨j.val + 1, nat.succ_lt_succ (lt_trans j.is_lt k.is_lt)⟩)),
  { congr, funext, rw sum_over.step_front },
  { rw [sum_over_sum, add_comm] }
end

lemma double_sum_triangle.helper2 {R :  Type _} [ring R]
  : ∀ {n : nat} (f : fin n.succ.succ → fin n.succ.succ → R),
    sum_over
      (λ (j : fin (nat.succ (nat.succ n))),
         sum_over (λ (i : fin (nat.succ (nat.succ n) - j.val)),
          f ⟨i.val + j.val, by { have h1 := nat.add_lt_add_right i.is_lt j.val, rw nat.sub_add_cancel (le_of_lt j.is_lt) at h1, exact h1 }⟩ j))
  = sum_over
      (λ (j : fin n.succ),
         sum_over (λ (i : fin (n.succ - j.val.succ)),
            f ⟨i.val + j.val.succ,
                by { have h1 := nat.add_lt_add_right i.is_lt j.val.succ,
                     rw nat.sub_add_cancel (nat.succ_le_of_lt j.is_lt) at h1,
                     transitivity n.succ, assumption, apply nat.lt_succ_self }⟩
              ⟨j.val.succ, nat.succ_lt_succ j.is_lt⟩))
  + sum_over (λ i : fin n.succ.succ, f ⟨i.val, i.is_lt⟩ ⟨0, nat.zero_lt_succ n.succ⟩)
  + sum_over (λ j : fin n.succ, f ⟨n.succ, nat.lt_succ_self _⟩ ⟨j.val.succ, nat.succ_lt_succ j.is_lt⟩) :=
begin
  intros, rw [sum_over.step_front],
  rw add_assoc, rw add_comm (sum_over (λ i : fin n.succ.succ, f ⟨i.val, i.is_lt⟩ ⟨0, nat.zero_lt_succ n.succ⟩)),
  rw add_comm, rw ← add_assoc, congr,
  transitivity
    sum_over
      (λ (j : fin n.succ),
         sum_over (λ (i : fin (n.succ.succ - j.val.succ)),
            f ⟨i.val + j.val.succ,
                by { have h1 := nat.add_lt_add_right i.is_lt j.val.succ,
                     rw nat.sub_add_cancel (le_of_lt (nat.succ_lt_succ j.is_lt)) at h1,
                     exact h1 }⟩
              ⟨j.val.succ, (nat.succ_lt_succ j.is_lt)⟩)),
  refl, rw ← sum_over_sum, congr, funext,
  transitivity sum_over
      (λ (i : fin (nat.succ (nat.succ n - nat.succ (j.val)))),
         f ⟨i.val + nat.succ (j.val),
              by { cases i with i i_is_lt, cases j with j j_is_lt,
                   have h2 := i_is_lt, rw ← nat.succ_sub at h2,
                   have h3 := nat.add_lt_add_right h2 (nat.succ j),
                   rw nat.sub_add_cancel at h3, exact h3,
                   apply le_trans, exact j_is_lt, apply le_of_lt (nat.lt_succ_self _), exact j_is_lt }⟩
           ⟨nat.succ j.val, nat.succ_lt_succ j.is_lt⟩),
  have : nat.succ (nat.succ n) - nat.succ (j.val) = nat.succ (nat.succ n - nat.succ (j.val)),
  { rw nat.succ_sub, apply nat.succ_le_succ, apply nat.le_of_succ_le_succ j.is_lt },
  congr, exact this, { apply fin.funext R this, intro x, cases x, simp },
  rw sum_over.step, congr, dsimp,
  rw nat.sub_add_cancel, exact j.is_lt
end

lemma double_sum_triangle {R :  Type _} [ring R]
  : ∀ {n} (f : fin n → fin n → R),
    sum_over (λ j : fin n, sum_over (λ k : fin j.val.succ, f j ⟨k.val, lt_of_lt_of_le k.is_lt j.is_lt⟩))
  = sum_over (λ k : fin n, sum_over (λ j : fin (n - k.val), f ⟨j.val + k.val, by { have h1 := nat.add_lt_add_right j.is_lt k.val, rw nat.sub_add_cancel (le_of_lt k.is_lt) at h1, exact h1, }⟩ k)) :=
begin
  apply nat.even_odd_induction
    (λ n, ∀ f : fin n → fin n → R,
     sum_over (λ j : fin n, sum_over (λ k : fin j.val.succ, f j ⟨k.val, lt_of_lt_of_le k.is_lt j.is_lt⟩))
     = sum_over (λ k : fin n, sum_over (λ j : fin (n - k.val), f ⟨j.val + k.val, by { have h1 := nat.add_lt_add_right j.is_lt k.val, rw nat.sub_add_cancel (le_of_lt k.is_lt) at h1, exact h1, }⟩ k))),
  intro f, simp [sum_over], simp [sum_over], intros n ih1 ih2 f,
  rw double_sum_triangle.helper1,
  rw double_sum_triangle.helper2,
  rw add_assoc, rw add_assoc, apply congr,
  { apply congr_arg,
    transitivity sum_over (λ i : fin n, sum_over (λ j : fin i.val.succ,
      f ⟨i.val.succ, nat.succ_lt_succ (lt_trans i.is_lt (nat.lt_succ_self _))⟩
        ⟨j.val.succ, nat.lt_of_le_of_lt j.is_lt (nat.succ_lt_succ (lt_trans i.is_lt (nat.lt_succ_self _)))⟩)),
    rw sum_over.step_front, simp [sum_over],
    congr, funext, congr, funext, congr, rw add_comm,
    transitivity sum_over (λ i : fin n, sum_over (λ j : fin i.val.succ,
      (λ (i' j' : fin n), f ⟨i'.val+1, nat.succ_lt_succ (lt_trans i'.is_lt (nat.lt_succ_self _))⟩
                            ⟨j'.val+1, nat.succ_lt_succ (lt_trans j'.is_lt (nat.lt_succ_self _))⟩)
        i ⟨j.val, lt_of_lt_of_le j.is_lt i.is_lt⟩)),
    refl, rw ih1, rw sum_over.step, simp [fin.restrict],
    symmetry, transitivity (0 : R) + sum_over
        (λ (k : fin n),
           sum_over
             (λ (i : fin (nat.succ n - nat.succ k.val)),
                f ⟨nat.succ (k.val) + i.val, by { have h1 := nat.add_lt_add_right i.is_lt k.val.succ, rw nat.sub_add_cancel (nat.succ_le_succ $ le_of_lt k.is_lt) at h1, rw add_comm,
                                                  apply lt_trans, exact h1, apply nat.lt_succ_self }⟩
                  ⟨nat.succ (k.val), lt_trans (nat.succ_lt_succ k.is_lt) (nat.lt_succ_self _)⟩)),
    { congr, transitivity sum_over (λ (i : fin (nat.succ n - nat.succ n)), f ⟨nat.succ n + i.val, _⟩ ⟨nat.succ n, _⟩),
      refl, transitivity sum_over (λ (i : fin 0), f ⟨nat.succ n + i.val, _⟩ ⟨nat.succ n, _⟩),
      congr, apply nat.sub_self, apply heq.funext, apply nat.sub_self, rw nat.sub_self, exact fin.elim0,
      apply i.elim0, apply i.elim0, refl },
    { rw zero_add, congr, funext,
      have : nat.succ n - nat.succ k.val = n - k.val := nat.succ_sub_succ n k.val,
      apply dep_fn_eq_of_heq (λ m, fin m → R), exact this,
      apply fin.funext, { intro x, cases x, simp }, exact this } },
  { rw @sum_over.step _ _ n.succ,
    rw sum_over.step ((λ (j : fin (nat.succ n)), f ⟨nat.succ n, _⟩ ⟨nat.succ (j.val), _⟩)),
    rw ← add_assoc, rw ← add_assoc, apply congr_fun,
    apply congr_arg, rw @sum_over.step _ _ n.succ,
    dsimp [fin.restrict],
    rw add_assoc, congr, rw sum_over.step_front },
end

-- I don't need this but it's neat ¯\_(ツ)_/¯
lemma mul_sum_eq_linear_sum {R : Type _} [ring R]
  : ∀ {n m} (f : fin n → R) (g : fin m → R),
    sum_over f * sum_over g
    = sum_over (λ p : fin (n * m),
                let p' := fin.line_to_square p
                in f p'.fst * g p'.snd) :=
begin
  intros, rw mul_sum_eq_double_sum,
  induction m,
  { transitivity (0 : R), apply sum_over_eq_zero ,
    rw (_ : (λ (p : fin (n * 0)), let p' : fin n × fin 0 := fin.line_to_square p in f (p'.fst) * g (p'.snd))
          = (λ (p : fin (n * 0)), 0)),
    rw sum_over_eq_zero , funext, rw mul_zero at p,
    apply p.elim0 },
  case nat.succ : m ih_m {
    simp [sum_over],
    rw sum_over_sum,
    rw [sum_over_split],
    rw add_comm,
    apply congr,
    { apply congr_arg,
      dsimp [fin.restrict_many, fin.restrict],
      rw ih_m, refl, },
    { rw (_ : (λ (p : fin (n * nat.succ m)), f ((fin.line_to_square p).fst) * g ((fin.line_to_square p).snd))
            = (λ (p : fin (n * nat.succ m)),
                (λ k : fin n × fin (nat.succ m), f (k.fst) * g (k.snd)) (fin.line_to_square p))),
      rw sum_over_tail, refl } }
end


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, v ∈ A ∨ v ∈ B, from by auto [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ v w : G, v ∈ A ∧ w ∈ A → ¬ (v, w) ∈ G.edges, from by auto [h2],
  have h4 : ∀ v w : G, v ∈ B ∧ w ∈ B → ¬ (v, w) ∈ G.edges, from by auto [h2],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : bipartite G, from by auto [h2, h3, h4],
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h6 : bipartite G,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h7 : two_colorable G, from by auto [h6],
  -- QED
  show two_colorable G ↔ bipartite G, from by auto [h5, h7],
end

--OUTPUT 2
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, (v ∈ A ∨ v ∈ B) ∧ (v ∉ A ∨ v ∉ B) ∧ (∀ u : G, (u ∈ A ∧ v ∈ A) → (u, v) ∉ E) ∧ (∀ u : G, (u ∈ B ∧ v ∈ B) → (u, v) ∉ E), from by auto [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ A B : set G, ∀ v : G, (v ∈ A ∨ v ∈ B) ∧ (v ∉ A ∨ v ∉ B) ∧ (∀ u : G, (u ∈ A ∧ v ∈ A) → (u, v) ∉ E) ∧ (∀ u : G, (u ∈ B ∧ v ∈ B) → (u, v) ∉ E) → (∀ u : G, (u ∈ A ∧ v ∈ A) → (u, v) ∉ E) ∧ (∀ u : G, (u ∈ B ∧ v ∈ B) → (u, v) ∉ E), from by auto [and.elim_left, and.elim_right],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h4 : ∀ A B : set G, ∀ v : G, (v ∈ A ∨ v ∈ B) ∧ (v ∉ A ∨ v ∉ B) ∧ (∀ u : G, (u ∈ A ∧ v ∈ A) → (u, v) ∉ E) ∧ (∀ u : G, (u ∈ B ∧ v ∈ B) → (u, v) ∉ E) → ∀ u : G, (u ∈ A ∧ v ∈ B) ∨ (u ∈ B ∧ v ∈ A) → (u, v) ∈ E, from by auto [and.elim_left, and.elim_right],
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h5 : bipartite G,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h6 : ∃ A B : set G, ∀ v : G, (v ∈ A ∨ v ∈ B) ∧ (v ∉ A ∨ v ∉ B) ∧ (∀ u : G, (u ∈ A ∧ v ∈ A) → (u, v) ∉ E) ∧ (∀ u : G, (u ∈ B ∧ v ∈ B) → (u, v) ∉ E), from by auto [h5],
  show two_colorable G ↔ bipartite G, from by auto [h1, h2, h3, h4, h5, h6]
end

--OUTPUT 3
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, v ∈ A ∨ v ∈ B, from by auto [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ v w : G, v ∈ A ∧ w ∈ A → ¬ edge v w, from by auto [h2],
  have h4 : ∀ v w : G, v ∈ B ∧ w ∈ B → ¬ edge v w, from by auto [h2],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ v w : G, edge v w → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A), from by auto [h2, h3, h4],
  show bipartite G, from by auto [h2, h5],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h6 : bipartite G,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h7 : ∃ A B : set G, ∀ v : G, v ∈ A ∨ v ∈ B ∧ ∀ v w : G, edge v w → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A), from by auto [h6],
  have h8 : ∀ v w : G, edge v w → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A), from by auto [h7],
  have h9 : ∀ v w : G, v ∈ A ∧ w ∈ A → ¬ edge v w, from by auto [h7, h8],
  have h10 : ∀ v w : G, v ∈ B ∧ w ∈ B → ¬ edge v w, from by auto [h7, h8],
  show two_colorable G, from by auto [h7, h9, h10],
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import ring_theory.polynomial.basic
import ring_theory.principal_ideal_domain
import data.mv_polynomial.basic

/-!
# Adjoining elements to form subalgebras

This file develops the basic theory of finitely-generated subalgebras.

## Definitions

* `fg (S : subalgebra R A)` : A predicate saying that the subalgebra is finitely-generated
as an A-algebra

## Tags

adjoin, algebra, finitely-generated algebra

-/

universes u v w

open subsemiring ring submodule
open_locale pointwise

namespace algebra

variables {R : Type u} {A : Type v} {B : Type w}
  [comm_semiring R] [comm_semiring A] [algebra R A] {s t : set A}

theorem fg_trans (h1 : (adjoin R s).to_submodule.fg)
  (h2 : (adjoin (adjoin R s) t).to_submodule.fg) :
  (adjoin R (s ∪ t)).to_submodule.fg :=
begin
  rcases fg_def.1 h1 with ⟨p, hp, hp'⟩,
  rcases fg_def.1 h2 with ⟨q, hq, hq'⟩,
  refine fg_def.2 ⟨p * q, hp.mul hq, le_antisymm _ _⟩,
  { rw [span_le],
    rintros _ ⟨x, y, hx, hy, rfl⟩,
    change x * y ∈ _,
    refine subalgebra.mul_mem _ _ _,
    { have : x ∈ (adjoin R s).to_submodule,
      { rw ← hp', exact subset_span hx },
      exact adjoin_mono (set.subset_union_left _ _) this },
    have : y ∈ (adjoin (adjoin R s) t).to_submodule,
    { rw ← hq', exact subset_span hy },
    change y ∈ adjoin R (s ∪ t), rwa adjoin_union_eq_adjoin_adjoin },
  { intros r hr,
    change r ∈ adjoin R (s ∪ t) at hr,
    rw adjoin_union_eq_adjoin_adjoin at hr,
    change r ∈ (adjoin (adjoin R s) t).to_submodule at hr,
    rw [← hq', ← set.image_id q, finsupp.mem_span_image_iff_total (adjoin R s)] at hr,
    rcases hr with ⟨l, hlq, rfl⟩,
    have := @finsupp.total_apply A A (adjoin R s),
    rw [this, finsupp.sum],
    refine sum_mem _,
    intros z hz, change (l z).1 * _ ∈ _,
    have : (l z).1 ∈ (adjoin R s).to_submodule := (l z).2,
    rw [← hp', ← set.image_id p, finsupp.mem_span_image_iff_total R] at this,
    rcases this with ⟨l2, hlp, hl⟩,
    have := @finsupp.total_apply A A R,
    rw this at hl,
    rw [←hl, finsupp.sum_mul],
    refine sum_mem _,
    intros t ht, change _ * _ ∈ _, rw smul_mul_assoc, refine smul_mem _ _ _,
    exact subset_span ⟨t, z, hlp ht, hlq hz, rfl⟩ }
end

end algebra

namespace subalgebra

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [semiring A] [algebra R A] [semiring B] [algebra R B]

/-- A subalgebra `S` is finitely generated if there exists `t : finset A` such that
`algebra.adjoin R t = S`. -/
def fg (S : subalgebra R A) : Prop :=
∃ t : finset A, algebra.adjoin R ↑t = S

lemma fg_adjoin_finset (s : finset A) : (algebra.adjoin R (↑s : set A)).fg :=
⟨s, rfl⟩

theorem fg_def {S : subalgebra R A} : S.fg ↔ ∃ t : set A, set.finite t ∧ algebra.adjoin R t = S :=
iff.symm set.exists_finite_iff_finset

theorem fg_bot : (⊥ : subalgebra R A).fg :=
⟨∅, algebra.adjoin_empty R A⟩

theorem fg_of_fg_to_submodule {S : subalgebra R A} : S.to_submodule.fg → S.fg :=
λ ⟨t, ht⟩, ⟨t, le_antisymm
  (algebra.adjoin_le (λ x hx, show x ∈ S.to_submodule, from ht ▸ subset_span hx)) $
  show S.to_submodule ≤ (algebra.adjoin R ↑t).to_submodule,
  from (λ x hx, span_le.mpr
    (λ x hx, algebra.subset_adjoin hx)
      (show x ∈ span R ↑t, by { rw ht, exact hx }))⟩

theorem fg_of_noetherian [is_noetherian R A] (S : subalgebra R A) : S.fg :=
fg_of_fg_to_submodule (is_noetherian.noetherian S.to_submodule)

lemma fg_of_submodule_fg (h : (⊤ : submodule R A).fg) : (⊤ : subalgebra R A).fg :=
let ⟨s, hs⟩ := h in ⟨s, to_submodule.injective $
by { rw [algebra.top_to_submodule, eq_top_iff, ← hs, span_le], exact algebra.subset_adjoin }⟩

lemma fg.prod {S : subalgebra R A} {T : subalgebra R B} (hS : S.fg) (hT : T.fg) : (S.prod T).fg :=
begin
  obtain ⟨s, hs⟩ := fg_def.1 hS,
  obtain ⟨t, ht⟩ := fg_def.1 hT,
  rw [← hs.2, ← ht.2],
  exact fg_def.2 ⟨(linear_map.inl R A B '' (s ∪ {1})) ∪ (linear_map.inr R A B '' (t ∪ {1})),
    set.finite.union (set.finite.image _ (set.finite.union hs.1 (set.finite_singleton _)))
    (set.finite.image _ (set.finite.union ht.1 (set.finite_singleton _))),
    algebra.adjoin_inl_union_inr_eq_prod R s t⟩
end

section
open_locale classical
lemma fg.map {S : subalgebra R A} (f : A →ₐ[R] B) (hs : S.fg) : (S.map f).fg :=
let ⟨s, hs⟩ := hs in ⟨s.image f, by rw [finset.coe_image, algebra.adjoin_image, hs]⟩
end

lemma fg_of_fg_map (S : subalgebra R A) (f : A →ₐ[R] B) (hf : function.injective f)
  (hs : (S.map f).fg) : S.fg :=
let ⟨s, hs⟩ := hs in ⟨s.preimage f $ λ _ _ _ _ h, hf h, map_injective hf $
by { rw [← algebra.adjoin_image, finset.coe_preimage, set.image_preimage_eq_of_subset, hs],
  rw [← alg_hom.coe_range, ← algebra.adjoin_le_iff, hs, ← algebra.map_top], exact map_mono le_top }⟩

lemma fg_top (S : subalgebra R A) : (⊤ : subalgebra R S).fg ↔ S.fg :=
⟨λ h, by { rw [← S.range_val, ← algebra.map_top], exact fg.map _ h },
λ h, fg_of_fg_map _ S.val subtype.val_injective $ by { rw [algebra.map_top, range_val], exact h }⟩

lemma induction_on_adjoin [is_noetherian R A] (P : subalgebra R A → Prop)
  (base : P ⊥) (ih : ∀ (S : subalgebra R A) (x : A), P S → P (algebra.adjoin R (insert x S)))
  (S : subalgebra R A) : P S :=
begin
  classical,
  obtain ⟨t, rfl⟩ := S.fg_of_noetherian,
  refine finset.induction_on t _ _,
  { simpa using base },
  intros x t hxt h,
  rw [finset.coe_insert],
  simpa only [algebra.adjoin_insert_adjoin] using ih _ x h,
end

end subalgebra

section semiring

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_semiring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]

/-- The image of a Noetherian R-algebra under an R-algebra map is a Noetherian ring. -/
instance alg_hom.is_noetherian_ring_range (f : A →ₐ[R] B) [is_noetherian_ring A] :
  is_noetherian_ring f.range :=
is_noetherian_ring_range f.to_ring_hom

end semiring

section ring

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_ring R] [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]

theorem is_noetherian_ring_of_fg {S : subalgebra R A} (HS : S.fg)
  [is_noetherian_ring R] : is_noetherian_ring S :=
let ⟨t, ht⟩ := HS in ht ▸ (algebra.adjoin_eq_range R (↑t : set A)).symm ▸
by haveI : is_noetherian_ring (mv_polynomial (↑t : set A) R) :=
mv_polynomial.is_noetherian_ring;
convert alg_hom.is_noetherian_ring_range _; apply_instance

theorem is_noetherian_subring_closure (s : set R) (hs : s.finite) :
  is_noetherian_ring (subring.closure s) :=
show is_noetherian_ring (subalgebra_of_subring (subring.closure s)), from
algebra.adjoin_int s ▸ is_noetherian_ring_of_fg (subalgebra.fg_def.2 ⟨s, hs, rfl⟩)

end ring


import data.real.basic

variables {x y : ℝ}

#check le_or_lt
#check @abs_of_neg
#check @abs_of_nonneg

-- BEGIN
example : x < abs y → x < y ∨ x < -y :=
begin
  cases le_or_gt 0 y with h1 h2,
  { rw abs_of_nonneg h1,
    sorry, },
  rw abs_of_neg h2,
  sorry,
end
-- END


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

! This file was ported from Lean 3 source module topology.metric_space.partition_of_unity
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.EmetricParacompact
import Mathbin.Analysis.Convex.PartitionOfUnity

/-!
# Lemmas about (e)metric spaces that need partition of unity

The main lemma in this file (see `metric.exists_continuous_real_forall_closed_ball_subset`) says the
following. Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets,
let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, → ℝ)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. We also formulate versions of this lemma for extended metric
spaces and for different codomains (`ℝ`, `ℝ≥0`, and `ℝ≥0∞`).

We also prove a few auxiliary lemmas to be used later in a proof of the smooth version of this
lemma.

## Tags

metric space, partition of unity, locally finite
-/

open Topology ENNReal BigOperators NNReal Filter

open Set Function Filter TopologicalSpace

variable {ι X : Type _}

namespace Emetric

variable [EMetricSpace X] {K : ι → Set X} {U : ι → Set X}

/-- Let `K : ι → set X` be a locally finitie family of closed sets in an emetric space. Let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then for any point
`x : X`, for sufficiently small `r : ℝ≥0∞` and for `y` sufficiently close to `x`, for all `i`, if
`y ∈ K i`, then `emetric.closed_ball y r ⊆ U i`. -/
theorem eventually_nhds_zero_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) (x : X) :
    ∀ᶠ p : ℝ≥0∞ × X in 𝓝 0 ×ᶠ 𝓝 x, ∀ i, p.2 ∈ K i → closedBall p.2 p.1 ⊆ U i :=
  by
  suffices ∀ i, x ∈ K i → ∀ᶠ p : ℝ≥0∞ × X in 𝓝 0 ×ᶠ 𝓝 x, closed_ball p.2 p.1 ⊆ U i
    by
    filter_upwards [tendsto_snd (hfin.Inter_compl_mem_nhds hK x),
      (eventually_all_finite (hfin.point_finite x)).2 this]
    rintro ⟨r, y⟩ hxy hyU i hi
    simp only [mem_Inter₂, mem_compl_iff, not_imp_not, mem_preimage] at hxy
    exact hyU _ (hxy _ hi)
  intro i hi
  rcases nhds_basis_closed_eball.mem_iff.1 ((hU i).mem_nhds <| hKU i hi) with ⟨R, hR₀, hR⟩
  rcases ennreal.lt_iff_exists_nnreal_btwn.mp hR₀ with ⟨r, hr₀, hrR⟩
  filter_upwards [prod_mem_prod (eventually_lt_nhds hr₀)
      (closed_ball_mem_nhds x (tsub_pos_iff_lt.2 hrR))]with p hp z hz
  apply hR
  calc
    edist z x ≤ edist z p.2 + edist p.2 x := edist_triangle _ _ _
    _ ≤ p.1 + (R - p.1) := (add_le_add hz <| le_trans hp.2 <| tsub_le_tsub_left hp.1.out.le _)
    _ = R := add_tsub_cancel_of_le (lt_trans hp.1 hrR).le

#align emetric.eventually_nhds_zero_forall_closed_ball_subset Emetric.eventually_nhds_zero_forall_closedBall_subset

theorem exists_forall_closedBall_subset_aux₁ (hK : ∀ i, IsClosed (K i)) (hU : ∀ i, IsOpen (U i))
    (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) (x : X) :
    ∃ r : ℝ,
      ∀ᶠ y in 𝓝 x,
        r ∈ Ioi (0 : ℝ) ∩ ENNReal.ofReal ⁻¹' ⋂ (i) (hi : y ∈ K i), { r | closedBall y r ⊆ U i } :=
  by
  have :=
    (ennreal.continuous_of_real.tendsto' 0 0 ENNReal.ofReal_zero).Eventually
      (eventually_nhds_zero_forall_closed_ball_subset hK hU hKU hfin x).curry
  rcases this.exists_gt with ⟨r, hr0, hr⟩
  refine' ⟨r, hr.mono fun y hy => ⟨hr0, _⟩⟩
  rwa [mem_preimage, mem_Inter₂]
#align emetric.exists_forall_closed_ball_subset_aux₁ Emetric.exists_forall_closedBall_subset_aux₁

theorem exists_forall_closedBall_subset_aux₂ (y : X) :
    Convex ℝ
      (Ioi (0 : ℝ) ∩ ENNReal.ofReal ⁻¹' ⋂ (i) (hi : y ∈ K i), { r | closedBall y r ⊆ U i }) :=
  (convex_Ioi _).inter <|
    OrdConnected.convex <|
      OrdConnected.preimage_ennreal_ofReal <|
        ordConnected_interᵢ fun i =>
          ordConnected_interᵢ fun hi => ordConnected_setOf_closedBall_subset y (U i)
#align emetric.exists_forall_closed_ball_subset_aux₂ Emetric.exists_forall_closedBall_subset_aux₂

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (ennreal.of_real (δ x)) ⊆ U i`. -/
theorem exists_continuous_real_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) :
    ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ (i), ∀ x ∈ K i, closedBall x (ENNReal.ofReal <| δ x) ⊆ U i :=
  by
  simpa only [mem_inter_iff, forall_and, mem_preimage, mem_Inter, @forall_swap ι X] using
    exists_continuous_forall_mem_convex_of_local_const exists_forall_closed_ball_subset_aux₂
      (exists_forall_closed_ball_subset_aux₁ hK hU hKU hfin)
#align emetric.exists_continuous_real_forall_closed_ball_subset Emetric.exists_continuous_real_forall_closedBall_subset

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
theorem exists_continuous_nNReal_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) :
    ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ (i), ∀ x ∈ K i, closedBall x (δ x) ⊆ U i :=
  by
  rcases exists_continuous_real_forall_closed_ball_subset hK hU hKU hfin with ⟨δ, hδ₀, hδ⟩
  lift δ to C(X, ℝ≥0) using fun x => (hδ₀ x).le
  refine' ⟨δ, hδ₀, fun i x hi => _⟩
  simpa only [← ENNReal.ofReal_coe_nnreal] using hδ i x hi
#align emetric.exists_continuous_nnreal_forall_closed_ball_subset Emetric.exists_continuous_nNReal_forall_closedBall_subset

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ≥0∞)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
theorem exists_continuous_eNNReal_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) :
    ∃ δ : C(X, ℝ≥0∞), (∀ x, 0 < δ x) ∧ ∀ (i), ∀ x ∈ K i, closedBall x (δ x) ⊆ U i :=
  let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nNReal_forall_closedBall_subset hK hU hKU hfin
  ⟨ContinuousMap.comp ⟨coe, ENNReal.continuous_coe⟩ δ, fun x => ENNReal.coe_pos.2 (hδ₀ x), hδ⟩
#align emetric.exists_continuous_ennreal_forall_closed_ball_subset Emetric.exists_continuous_eNNReal_forall_closedBall_subset

end Emetric

namespace Metric

variable [MetricSpace X] {K : ι → Set X} {U : ι → Set X}

/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. -/
theorem exists_continuous_nNReal_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) :
    ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ (i), ∀ x ∈ K i, closedBall x (δ x) ⊆ U i :=
  by
  rcases Emetric.exists_continuous_nNReal_forall_closedBall_subset hK hU hKU hfin with ⟨δ, hδ0, hδ⟩
  refine' ⟨δ, hδ0, fun i x hx => _⟩
  rw [← emetric_closed_ball_nnreal]
  exact hδ i x hx
#align metric.exists_continuous_nnreal_forall_closed_ball_subset Metric.exists_continuous_nNReal_forall_closedBall_subset

/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. -/
theorem exists_continuous_real_forall_closedBall_subset (hK : ∀ i, IsClosed (K i))
    (hU : ∀ i, IsOpen (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : LocallyFinite K) :
    ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ (i), ∀ x ∈ K i, closedBall x (δ x) ⊆ U i :=
  let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nNReal_forall_closedBall_subset hK hU hKU hfin
  ⟨ContinuousMap.comp ⟨coe, NNReal.continuous_coe⟩ δ, hδ₀, hδ⟩
#align metric.exists_continuous_real_forall_closed_ball_subset Metric.exists_continuous_real_forall_closedBall_subset

end Metric


import ring_theory.algebra data.fintype.basic linear_algebra.dimension

universes u v w

variables (K : Type u) (L : Type v) [field K] [field L]

class finite_Galois_extension extends algebra K L.

definition galois_group : Type u → Type v → Type w := sorry

instance [finite_Galois_extension K L] :
fintype (galois_group L K) := sorry

-- needs fixing
theorem fundamental_theorem_of_Galois_theory (HL : finite_Galois_extension K L) :
(fintype.card (galois_group L K) : cardinal) = vector_space.dim K L := sorry


theorem ex1 (x : Nat) (y : { v // v > x }) (z : Nat) : Nat :=
by {
  clear y x;
  exact z
}

theorem ex2 (x : Nat) (y : { v // v > x }) (z : Nat) : Nat :=
by {
  clear x y;
  exact z
}

theorem ex3 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  have : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  assumption
}

theorem ex4 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  let h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex5 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  have h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex6 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : id (x + 0 = z) :=
by {
  show x = z;
  have h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex7 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z := by
have : y = z := by apply Eq.symm; assumption
apply Eq.trans
exact h₁
assumption

theorem ex8 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by apply Eq.trans h₁;
   have : y = z := by
     apply Eq.symm;
     assumption;
   exact this

example (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z := by
  sorry

example (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z := by
  apply Eq.trans
  · sorry
  · sorry
  · sorry

example (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z := by
  apply Eq.trans <;> sorry