/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Andreas Swerdlow
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.matrix
import Mathlib.linear_algebra.tensor_product
import Mathlib.linear_algebra.nonsingular_inverse
import Mathlib.PostPort

universes u v l u_1 w u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Bilinear form

This file defines a bilinear form over a module. Basic ideas
such as orthogonality are also introduced, as well as reflexivive,
symmetric and alternating bilinear forms. Adjoints of linear maps
with respect to a bilinear form are also introduced.

A bilinear form on an R-(semi)module M, is a function from M x M to R,
that is linear in both arguments. Comments will typically abbreviate
"(semi)module" as just "module", but the definitions should be as general as
possible.

## Notations

Given any term B of type bilin_form, due to a coercion, can use
the notation B x y to refer to the function field, ie. B x y = B.bilin x y.

In this file we use the following type variables:
 - `M`, `M'`, ... are semimodules over the semiring `R`,
 - `M₁`, `M₁'`, ... are modules over the ring `R₁`,
 - `M₂`, `M₂'`, ... are semimodules over the commutative semiring `R₂`
 - `M₃`, `M₃'`, ... are modules over the commutative ring `R₃`

## References

* <https://en.wikipedia.org/wiki/Bilinear_form>

## Tags

Bilinear form,
-/

/-- `bilin_form R M` is the type of `R`-bilinear functions `M → M → R`. -/
structure bilin_form (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M] [semimodule R M]
where
  bilin : M → M → R
  bilin_add_left : ∀ (x y z : M), bilin (x + y) z = bilin x z + bilin y z
  bilin_smul_left : ∀ (a : R) (x y : M), bilin (a • x) y = a * bilin x y
  bilin_add_right : ∀ (x y z : M), bilin x (y + z) = bilin x y + bilin x z
  bilin_smul_right : ∀ (a : R) (x y : M), bilin x (a • y) = a * bilin x y

namespace bilin_form

protected instance has_coe_to_fun {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : has_coe_to_fun (bilin_form R M) :=
  has_coe_to_fun.mk (fun (B : bilin_form R M) => M → M → R) fun (B : bilin_form R M) => bilin B

@[simp] theorem coe_fn_mk {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (f : M → M → R) (h₁ : ∀ (x y z : M), f (x + y) z = f x z + f y z) (h₂ : ∀ (a : R) (x y : M), f (a • x) y = a * f x y) (h₃ : ∀ (x y z : M), f x (y + z) = f x y + f x z) (h₄ : ∀ (a : R) (x y : M), f x (a • y) = a * f x y) : ⇑(mk f h₁ h₂ h₃ h₄) = f :=
  rfl

theorem coe_fn_congr {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {x : M} {x' : M} {y : M} {y' : M} : x = x' → y = y' → coe_fn B x y = coe_fn B x' y' := sorry

@[simp] theorem add_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (x : M) (y : M) (z : M) : coe_fn B (x + y) z = coe_fn B x z + coe_fn B y z :=
  bilin_add_left B x y z

@[simp] theorem smul_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (a : R) (x : M) (y : M) : coe_fn B (a • x) y = a * coe_fn B x y :=
  bilin_smul_left B a x y

@[simp] theorem add_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (x : M) (y : M) (z : M) : coe_fn B x (y + z) = coe_fn B x y + coe_fn B x z :=
  bilin_add_right B x y z

@[simp] theorem smul_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (a : R) (x : M) (y : M) : coe_fn B x (a • y) = a * coe_fn B x y :=
  bilin_smul_right B a x y

@[simp] theorem zero_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (x : M) : coe_fn B 0 x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B 0 x = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B (0 • 0) x = 0)) (smul_left 0 0 x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * coe_fn B 0 x = 0)) (zero_mul (coe_fn B 0 x)))) (Eq.refl 0)))

@[simp] theorem zero_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (x : M) : coe_fn B x 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B x 0 = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B x (0 • 0) = 0)) (smul_right 0 x 0)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * coe_fn B x 0 = 0)) (zero_mul (coe_fn B x 0)))) (Eq.refl 0)))

@[simp] theorem neg_left {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn B₁ (-x) y = -coe_fn B₁ x y := sorry

@[simp] theorem neg_right {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn B₁ x (-y) = -coe_fn B₁ x y := sorry

@[simp] theorem sub_left {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) (z : M₁) : coe_fn B₁ (x - y) z = coe_fn B₁ x z - coe_fn B₁ y z := sorry

@[simp] theorem sub_right {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) (z : M₁) : coe_fn B₁ x (y - z) = coe_fn B₁ x y - coe_fn B₁ x z := sorry

theorem ext {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {D : bilin_form R M} (H : ∀ (x y : M), coe_fn B x y = coe_fn D x y) : B = D := sorry

protected instance add_comm_monoid {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : add_comm_monoid (bilin_form R M) :=
  add_comm_monoid.mk
    (fun (B D : bilin_form R M) => mk (fun (x y : M) => coe_fn B x y + coe_fn D x y) sorry sorry sorry sorry) sorry
    (mk (fun (x y : M) => 0) sorry sorry sorry sorry) sorry sorry sorry

protected instance add_comm_group {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] : add_comm_group (bilin_form R₁ M₁) :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
    (fun (B : bilin_form R₁ M₁) => mk (fun (x y : M₁) => -bilin B x y) sorry sorry sorry sorry)
    (add_group.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
      fun (B : bilin_form R₁ M₁) => mk (fun (x y : M₁) => -bilin B x y) sorry sorry sorry sorry)
    sorry sorry

@[simp] theorem add_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {D : bilin_form R M} (x : M) (y : M) : coe_fn (B + D) x y = coe_fn B x y + coe_fn D x y :=
  rfl

@[simp] theorem neg_apply {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn (-B₁) x y = -coe_fn B₁ x y :=
  rfl

protected instance inhabited {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : Inhabited (bilin_form R M) :=
  { default := 0 }

protected instance semimodule {M : Type v} [add_comm_monoid M] {R : Type u_1} [comm_semiring R] [semimodule R M] : semimodule R (bilin_form R M) :=
  semimodule.mk sorry sorry

@[simp] theorem smul_apply {M : Type v} [add_comm_monoid M] {R : Type u_1} [comm_semiring R] [semimodule R M] (B : bilin_form R M) (a : R) (x : M) (y : M) : coe_fn (a • B) x y = a • coe_fn B x y :=
  rfl

end bilin_form

/-- A map with two arguments that is linear in both is a bilinear form.

This is an auxiliary definition for the full linear equivalence `linear_map.to_bilin`.
-/
def linear_map.to_bilin_aux {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (f : linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) : bilin_form R₂ M₂ :=
  bilin_form.mk (fun (x y : M₂) => coe_fn (coe_fn f x) y) sorry sorry sorry sorry

/-- A map with two arguments that is linear in both is linearly equivalent to bilinear form. -/
def linear_map.to_bilin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] : linear_equiv R₂ (linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) (bilin_form R₂ M₂) :=
  linear_equiv.mk linear_map.to_bilin_aux sorry sorry
    (fun (F : bilin_form R₂ M₂) => linear_map.mk₂ R₂ ⇑F sorry sorry sorry sorry) sorry sorry

/-- Bilinear forms are linearly equivalent to maps with two arguments that are linear in both. -/
def bilin_form.to_lin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] : linear_equiv R₂ (bilin_form R₂ M₂) (linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) :=
  linear_equiv.symm linear_map.to_bilin

@[simp] theorem linear_map.to_bilin_aux_eq {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (f : linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) : linear_map.to_bilin_aux f = coe_fn linear_map.to_bilin f :=
  rfl

@[simp] theorem linear_map.to_bilin_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] : linear_equiv.symm linear_map.to_bilin = bilin_form.to_lin :=
  rfl

@[simp] theorem bilin_form.to_lin_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] : linear_equiv.symm bilin_form.to_lin = linear_map.to_bilin :=
  linear_equiv.symm_symm linear_map.to_bilin

@[simp] theorem to_linear_map_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} (x : M₂) : ⇑(coe_fn (coe_fn bilin_form.to_lin B₂) x) = coe_fn B₂ x :=
  rfl

@[simp] theorem map_sum_left {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {α : Type u_1} (t : finset α) (g : α → M₂) (w : M₂) : coe_fn B₂ (finset.sum t fun (i : α) => g i) w = finset.sum t fun (i : α) => coe_fn B₂ (g i) w := sorry

@[simp] theorem map_sum_right {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {α : Type u_1} (t : finset α) (w : M₂) (g : α → M₂) : coe_fn B₂ w (finset.sum t fun (i : α) => g i) = finset.sum t fun (i : α) => coe_fn B₂ w (g i) := sorry

namespace bilin_form

/-- Apply a linear map on the left and right argument of a bilinear form. -/
def comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {M' : Type w} [add_comm_monoid M'] [semimodule R M'] (B : bilin_form R M') (l : linear_map R M M') (r : linear_map R M M') : bilin_form R M :=
  mk (fun (x y : M) => coe_fn B (coe_fn l x) (coe_fn r y)) sorry sorry sorry sorry

/-- Apply a linear map to the left argument of a bilinear form. -/
def comp_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) : bilin_form R M :=
  comp B f linear_map.id

/-- Apply a linear map to the right argument of a bilinear form. -/
def comp_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) : bilin_form R M :=
  comp B linear_map.id f

theorem comp_comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {M' : Type w} [add_comm_monoid M'] [semimodule R M'] {M'' : Type u_1} [add_comm_monoid M''] [semimodule R M''] (B : bilin_form R M'') (l : linear_map R M M') (r : linear_map R M M') (l' : linear_map R M' M'') (r' : linear_map R M' M'') : comp (comp B l' r') l r = comp B (linear_map.comp l' l) (linear_map.comp r' r) :=
  rfl

@[simp] theorem comp_left_comp_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (l : linear_map R M M) (r : linear_map R M M) : comp_right (comp_left B l) r = comp B l r :=
  rfl

@[simp] theorem comp_right_comp_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (l : linear_map R M M) (r : linear_map R M M) : comp_left (comp_right B r) l = comp B l r :=
  rfl

@[simp] theorem comp_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {M' : Type w} [add_comm_monoid M'] [semimodule R M'] (B : bilin_form R M') (l : linear_map R M M') (r : linear_map R M M') (v : M) (w : M) : coe_fn (comp B l r) v w = coe_fn B (coe_fn l v) (coe_fn r w) :=
  rfl

@[simp] theorem comp_left_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) (v : M) (w : M) : coe_fn (comp_left B f) v w = coe_fn B (coe_fn f v) w :=
  rfl

@[simp] theorem comp_right_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) (v : M) (w : M) : coe_fn (comp_right B f) v w = coe_fn B v (coe_fn f w) :=
  rfl

theorem comp_injective {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {M' : Type w} [add_comm_monoid M'] [semimodule R M'] (B₁ : bilin_form R M') (B₂ : bilin_form R M') (l : linear_map R M M') (r : linear_map R M M') (hₗ : function.surjective ⇑l) (hᵣ : function.surjective ⇑r) : comp B₁ l r = comp B₂ l r ↔ B₁ = B₂ := sorry

/-- Apply a linear equivalence on the arguments of a bilinear form. -/
def congr {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] (e : linear_equiv R₂ M₂ M₂') : linear_equiv R₂ (bilin_form R₂ M₂) (bilin_form R₂ M₂') :=
  linear_equiv.mk (fun (B : bilin_form R₂ M₂) => comp B ↑(linear_equiv.symm e) ↑(linear_equiv.symm e)) sorry sorry
    (fun (B : bilin_form R₂ M₂') => comp B ↑e ↑e) sorry sorry

@[simp] theorem congr_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] (e : linear_equiv R₂ M₂ M₂') (B : bilin_form R₂ M₂) (x : M₂') (y : M₂') : coe_fn (coe_fn (congr e) B) x y = coe_fn B (coe_fn (linear_equiv.symm e) x) (coe_fn (linear_equiv.symm e) y) :=
  rfl

@[simp] theorem congr_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] (e : linear_equiv R₂ M₂ M₂') : linear_equiv.symm (congr e) = congr (linear_equiv.symm e) := sorry

theorem congr_comp {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {M₂'' : Type u_2} [add_comm_monoid M₂''] [semimodule R₂ M₂''] (e : linear_equiv R₂ M₂ M₂') (B : bilin_form R₂ M₂) (l : linear_map R₂ M₂'' M₂') (r : linear_map R₂ M₂'' M₂') : comp (coe_fn (congr e) B) l r =
  comp B (linear_map.comp (↑(linear_equiv.symm e)) l) (linear_map.comp (↑(linear_equiv.symm e)) r) :=
  rfl

theorem comp_congr {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {M₂'' : Type u_2} [add_comm_monoid M₂''] [semimodule R₂ M₂''] (e : linear_equiv R₂ M₂' M₂'') (B : bilin_form R₂ M₂) (l : linear_map R₂ M₂' M₂) (r : linear_map R₂ M₂' M₂) : coe_fn (congr e) (comp B l r) =
  comp B (linear_map.comp l ↑(linear_equiv.symm e)) (linear_map.comp r ↑(linear_equiv.symm e)) :=
  rfl

/-- `lin_mul_lin f g` is the bilinear form mapping `x` and `y` to `f x * g y` -/
def lin_mul_lin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (f : linear_map R₂ M₂ R₂) (g : linear_map R₂ M₂ R₂) : bilin_form R₂ M₂ :=
  mk (fun (x y : M₂) => coe_fn f x * coe_fn g y) sorry sorry sorry sorry

@[simp] theorem lin_mul_lin_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂} (x : M₂) (y : M₂) : coe_fn (lin_mul_lin f g) x y = coe_fn f x * coe_fn g y :=
  rfl

@[simp] theorem lin_mul_lin_comp {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂} (l : linear_map R₂ M₂' M₂) (r : linear_map R₂ M₂' M₂) : comp (lin_mul_lin f g) l r = lin_mul_lin (linear_map.comp f l) (linear_map.comp g r) :=
  rfl

@[simp] theorem lin_mul_lin_comp_left {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂} (l : linear_map R₂ M₂ M₂) : comp_left (lin_mul_lin f g) l = lin_mul_lin (linear_map.comp f l) g :=
  rfl

@[simp] theorem lin_mul_lin_comp_right {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂} (r : linear_map R₂ M₂ M₂) : comp_right (lin_mul_lin f g) r = lin_mul_lin f (linear_map.comp g r) :=
  rfl

/-- The proposition that two elements of a bilinear form space are orthogonal -/
def is_ortho {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (x : M) (y : M) :=
  coe_fn B x y = 0

theorem ortho_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (x : M) : is_ortho B 0 x :=
  zero_left x

@[simp] theorem is_ortho_smul_left {R₄ : Type u_2} {M₄ : Type u_3} [domain R₄] [add_comm_group M₄] [module R₄ M₄] {G : bilin_form R₄ M₄} {x : M₄} {y : M₄} {a : R₄} (ha : a ≠ 0) : is_ortho G (a • x) y ↔ is_ortho G x y := sorry

@[simp] theorem is_ortho_smul_right {R₄ : Type u_2} {M₄ : Type u_3} [domain R₄] [add_comm_group M₄] [module R₄ M₄] {G : bilin_form R₄ M₄} {x : M₄} {y : M₄} {a : R₄} (ha : a ≠ 0) : is_ortho G x (a • y) ↔ is_ortho G x y := sorry

/-- Two bilinear forms are equal when they are equal on all basis vectors. -/
theorem ext_basis {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {B₃ : bilin_form R₃ M₃} {F₃ : bilin_form R₃ M₃} {ι : Type u_2} {b : ι → M₃} (hb : is_basis R₃ b) (h : ∀ (i j : ι), coe_fn B₃ (b i) (b j) = coe_fn F₃ (b i) (b j)) : B₃ = F₃ :=
  linear_equiv.injective to_lin (is_basis.ext hb fun (i : ι) => is_basis.ext hb fun (j : ι) => h i j)

/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis. -/
theorem sum_repr_mul_repr_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {B₃ : bilin_form R₃ M₃} {ι : Type u_2} {b : ι → M₃} (hb : is_basis R₃ b) (x : M₃) (y : M₃) : (finsupp.sum (coe_fn (is_basis.repr hb) x)
    fun (i : ι) (xi : R₃) =>
      finsupp.sum (coe_fn (is_basis.repr hb) y) fun (j : ι) (yj : R₃) => xi • yj • coe_fn B₃ (b i) (b j)) =
  coe_fn B₃ x y := sorry

end bilin_form

/-- The map from `matrix n n R` to bilinear forms on `n → R`.

This is an auxiliary definition for the equivalence `matrix.to_bilin_form'`. -/
def matrix.to_bilin'_aux {R₂ : Type u} [comm_semiring R₂] {n : Type u_1} [fintype n] (M : matrix n n R₂) : bilin_form R₂ (n → R₂) :=
  bilin_form.mk
    (fun (v w : n → R₂) => finset.sum finset.univ fun (i : n) => finset.sum finset.univ fun (j : n) => v i * M i j * w j)
    sorry sorry sorry sorry

theorem matrix.to_bilin'_aux_std_basis {R₂ : Type u} [comm_semiring R₂] {n : Type u_1} [fintype n] [DecidableEq n] (M : matrix n n R₂) (i : n) (j : n) : coe_fn (matrix.to_bilin'_aux M) (coe_fn (linear_map.std_basis R₂ (fun (ᾰ : n) => R₂) i) 1)
    (coe_fn (linear_map.std_basis R₂ (fun (ᾰ : n) => R₂) j) 1) =
  M i j := sorry

/-- The linear map from bilinear forms to `matrix n n R` given an `n`-indexed basis.

This is an auxiliary definition for the equivalence `matrix.to_bilin_form'`. -/
def bilin_form.to_matrix_aux {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {n : Type u_1} [fintype n] (b : n → M₂) : linear_map R₂ (bilin_form R₂ M₂) (matrix n n R₂) :=
  linear_map.mk (fun (B : bilin_form R₂ M₂) (i j : n) => coe_fn B (b i) (b j)) sorry sorry

theorem to_bilin'_aux_to_matrix_aux {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B₃ : bilin_form R₃ (n → R₃)) : matrix.to_bilin'_aux
    (coe_fn (bilin_form.to_matrix_aux fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) B₃) =
  B₃ := sorry

/-! ### `to_matrix'` section

This section deals with the conversion between matrices and bilinear forms on `n → R₃`.
-/

/-- The linear equivalence between bilinear forms on `n → R` and `n × n` matrices -/
def bilin_form.to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : linear_equiv R₃ (bilin_form R₃ (n → R₃)) (matrix n n R₃) :=
  linear_equiv.mk
    (linear_map.to_fun (bilin_form.to_matrix_aux fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1))
    sorry sorry matrix.to_bilin'_aux sorry sorry

@[simp] theorem bilin_form.to_matrix_aux_std_basis {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) : coe_fn (bilin_form.to_matrix_aux fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) B =
  coe_fn bilin_form.to_matrix' B :=
  rfl

/-- The linear equivalence between `n × n` matrices and bilinear forms on `n → R` -/
def matrix.to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : linear_equiv R₃ (matrix n n R₃) (bilin_form R₃ (n → R₃)) :=
  linear_equiv.symm bilin_form.to_matrix'

@[simp] theorem matrix.to_bilin'_aux_eq {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (M : matrix n n R₃) : matrix.to_bilin'_aux M = coe_fn matrix.to_bilin' M :=
  rfl

theorem matrix.to_bilin'_apply {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (M : matrix n n R₃) (x : n → R₃) (y : n → R₃) : coe_fn (coe_fn matrix.to_bilin' M) x y =
  finset.sum finset.univ fun (i : n) => finset.sum finset.univ fun (j : n) => x i * M i j * y j :=
  rfl

@[simp] theorem matrix.to_bilin'_std_basis {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (M : matrix n n R₃) (i : n) (j : n) : coe_fn (coe_fn matrix.to_bilin' M) (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1)
    (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) =
  M i j :=
  matrix.to_bilin'_aux_std_basis M i j

@[simp] theorem bilin_form.to_matrix'_symm {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : linear_equiv.symm bilin_form.to_matrix' = matrix.to_bilin' :=
  rfl

@[simp] theorem matrix.to_bilin'_symm {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : linear_equiv.symm matrix.to_bilin' = bilin_form.to_matrix' :=
  linear_equiv.symm_symm bilin_form.to_matrix'

@[simp] theorem matrix.to_bilin'_to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) : coe_fn matrix.to_bilin' (coe_fn bilin_form.to_matrix' B) = B :=
  linear_equiv.apply_symm_apply matrix.to_bilin' B

@[simp] theorem bilin_form.to_matrix'_to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (M : matrix n n R₃) : coe_fn bilin_form.to_matrix' (coe_fn matrix.to_bilin' M) = M :=
  linear_equiv.apply_symm_apply bilin_form.to_matrix' M

@[simp] theorem bilin_form.to_matrix'_apply {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (i : n) (j : n) : coe_fn bilin_form.to_matrix' B i j =
  coe_fn B (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1)
    (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) :=
  rfl

@[simp] theorem bilin_form.to_matrix'_comp {R₃ : Type u} [comm_ring R₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] [DecidableEq o] (B : bilin_form R₃ (n → R₃)) (l : linear_map R₃ (o → R₃) (n → R₃)) (r : linear_map R₃ (o → R₃) (n → R₃)) : coe_fn bilin_form.to_matrix' (bilin_form.comp B l r) =
  matrix.mul (matrix.mul (matrix.transpose (coe_fn linear_map.to_matrix' l)) (coe_fn bilin_form.to_matrix' B))
    (coe_fn linear_map.to_matrix' r) := sorry

theorem bilin_form.to_matrix'_comp_left {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (f : linear_map R₃ (n → R₃) (n → R₃)) : coe_fn bilin_form.to_matrix' (bilin_form.comp_left B f) =
  matrix.mul (matrix.transpose (coe_fn linear_map.to_matrix' f)) (coe_fn bilin_form.to_matrix' B) := sorry

theorem bilin_form.to_matrix'_comp_right {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (f : linear_map R₃ (n → R₃) (n → R₃)) : coe_fn bilin_form.to_matrix' (bilin_form.comp_right B f) =
  matrix.mul (coe_fn bilin_form.to_matrix' B) (coe_fn linear_map.to_matrix' f) := sorry

theorem bilin_form.mul_to_matrix'_mul {R₃ : Type u} [comm_ring R₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] [DecidableEq o] (B : bilin_form R₃ (n → R₃)) (M : matrix o n R₃) (N : matrix n o R₃) : matrix.mul (matrix.mul M (coe_fn bilin_form.to_matrix' B)) N =
  coe_fn bilin_form.to_matrix'
    (bilin_form.comp B (coe_fn matrix.to_lin' (matrix.transpose M)) (coe_fn matrix.to_lin' N)) := sorry

theorem bilin_form.mul_to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) : matrix.mul M (coe_fn bilin_form.to_matrix' B) =
  coe_fn bilin_form.to_matrix' (bilin_form.comp_left B (coe_fn matrix.to_lin' (matrix.transpose M))) := sorry

theorem bilin_form.to_matrix'_mul {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) : matrix.mul (coe_fn bilin_form.to_matrix' B) M =
  coe_fn bilin_form.to_matrix' (bilin_form.comp_right B (coe_fn matrix.to_lin' M)) := sorry

theorem matrix.to_bilin'_comp {R₃ : Type u} [comm_ring R₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] [DecidableEq o] (M : matrix n n R₃) (P : matrix n o R₃) (Q : matrix n o R₃) : bilin_form.comp (coe_fn matrix.to_bilin' M) (coe_fn matrix.to_lin' P) (coe_fn matrix.to_lin' Q) =
  coe_fn matrix.to_bilin' (matrix.mul (matrix.mul (matrix.transpose P) M) Q) := sorry

/-! ### `to_matrix` section

This section deals with the conversion between matrices and bilinear forms on
a module with a fixed basis.
-/

/-- `bilin_form.to_matrix hb` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `hb` is an `R`-basis for `M`. -/
def bilin_form.to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) : linear_equiv R₃ (bilin_form R₃ M₃) (matrix n n R₃) :=
  linear_equiv.trans (bilin_form.congr (is_basis.equiv_fun hb)) bilin_form.to_matrix'

/-- `bilin_form.to_matrix hb` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `hb` is an `R`-basis for `M`. -/
def matrix.to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) : linear_equiv R₃ (matrix n n R₃) (bilin_form R₃ M₃) :=
  linear_equiv.symm (bilin_form.to_matrix hb)

@[simp] theorem is_basis.equiv_fun_symm_std_basis {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (i : n) : coe_fn (linear_equiv.symm (is_basis.equiv_fun hb)) (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1) = b i := sorry

@[simp] theorem bilin_form.to_matrix_apply {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (i : n) (j : n) : coe_fn (bilin_form.to_matrix hb) B i j = coe_fn B (b i) (b j) := sorry

@[simp] theorem matrix.to_bilin_apply {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (M : matrix n n R₃) (x : M₃) (y : M₃) : coe_fn (coe_fn (matrix.to_bilin hb) M) x y =
  finset.sum finset.univ
    fun (i : n) =>
      finset.sum finset.univ
        fun (j : n) => coe_fn (coe_fn (is_basis.repr hb) x) i * M i j * coe_fn (coe_fn (is_basis.repr hb) y) j := sorry

-- Not a `simp` lemma since `bilin_form.to_matrix` needs an extra argument

theorem bilinear_form.to_matrix_aux_eq {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) : coe_fn (bilin_form.to_matrix_aux b) B = coe_fn (bilin_form.to_matrix hb) B := sorry

@[simp] theorem bilin_form.to_matrix_symm {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) : linear_equiv.symm (bilin_form.to_matrix hb) = matrix.to_bilin hb :=
  rfl

@[simp] theorem matrix.to_bilin_symm {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) : linear_equiv.symm (matrix.to_bilin hb) = bilin_form.to_matrix hb :=
  linear_equiv.symm_symm (bilin_form.to_matrix hb)

theorem matrix.to_bilin_is_basis_fun {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : matrix.to_bilin (pi.is_basis_fun R₃ n) = matrix.to_bilin' := sorry

theorem bilin_form.to_matrix_is_basis_fun {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] : bilin_form.to_matrix (pi.is_basis_fun R₃ n) = bilin_form.to_matrix' := sorry

@[simp] theorem matrix.to_bilin_to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) : coe_fn (matrix.to_bilin hb) (coe_fn (bilin_form.to_matrix hb) B) = B :=
  linear_equiv.apply_symm_apply (matrix.to_bilin hb) B

@[simp] theorem bilin_form.to_matrix_to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (M : matrix n n R₃) : coe_fn (bilin_form.to_matrix hb) (coe_fn (matrix.to_bilin hb) M) = M :=
  linear_equiv.apply_symm_apply (bilin_form.to_matrix hb) M

-- Cannot be a `simp` lemma because `hb` must be inferred.

theorem bilin_form.to_matrix_comp {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃'] {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (B : bilin_form R₃ M₃) (l : linear_map R₃ M₃' M₃) (r : linear_map R₃ M₃' M₃) : coe_fn (bilin_form.to_matrix hc) (bilin_form.comp B l r) =
  matrix.mul
    (matrix.mul (matrix.transpose (coe_fn (linear_map.to_matrix hc hb) l)) (coe_fn (bilin_form.to_matrix hb) B))
    (coe_fn (linear_map.to_matrix hc hb) r) := sorry

theorem bilin_form.to_matrix_comp_left {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (f : linear_map R₃ M₃ M₃) : coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_left B f) =
  matrix.mul (matrix.transpose (coe_fn (linear_map.to_matrix hb hb) f)) (coe_fn (bilin_form.to_matrix hb) B) := sorry

theorem bilin_form.to_matrix_comp_right {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (f : linear_map R₃ M₃ M₃) : coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_right B f) =
  matrix.mul (coe_fn (bilin_form.to_matrix hb) B) (coe_fn (linear_map.to_matrix hb hb) f) := sorry

theorem bilin_form.mul_to_matrix_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃'] {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (B : bilin_form R₃ M₃) (M : matrix o n R₃) (N : matrix n o R₃) : matrix.mul (matrix.mul M (coe_fn (bilin_form.to_matrix hb) B)) N =
  coe_fn (bilin_form.to_matrix hc)
    (bilin_form.comp B (coe_fn (matrix.to_lin hc hb) (matrix.transpose M)) (coe_fn (matrix.to_lin hc hb) N)) := sorry

theorem bilin_form.mul_to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (M : matrix n n R₃) : matrix.mul M (coe_fn (bilin_form.to_matrix hb) B) =
  coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_left B (coe_fn (matrix.to_lin hb hb) (matrix.transpose M))) := sorry

theorem bilin_form.to_matrix_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (M : matrix n n R₃) : matrix.mul (coe_fn (bilin_form.to_matrix hb) B) M =
  coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_right B (coe_fn (matrix.to_lin hb hb) M)) := sorry

theorem matrix.to_bilin_comp {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃'] {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (M : matrix n n R₃) (P : matrix n o R₃) (Q : matrix n o R₃) : bilin_form.comp (coe_fn (matrix.to_bilin hb) M) (coe_fn (matrix.to_lin hc hb) P) (coe_fn (matrix.to_lin hc hb) Q) =
  coe_fn (matrix.to_bilin hc) (matrix.mul (matrix.mul (matrix.transpose P) M) Q) := sorry

namespace refl_bilin_form

/-- The proposition that a bilinear form is reflexive -/
def is_refl {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) :=
  ∀ (x y : M), coe_fn B x y = 0 → coe_fn B y x = 0

theorem eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_refl B) {x : M} {y : M} : coe_fn B x y = 0 → coe_fn B y x = 0 :=
  H x y

theorem ortho_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_refl B) {x : M} {y : M} : bilin_form.is_ortho B x y ↔ bilin_form.is_ortho B y x :=
  { mp := eq_zero H, mpr := eq_zero H }

end refl_bilin_form

namespace sym_bilin_form

/-- The proposition that a bilinear form is symmetric -/
def is_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) :=
  ∀ (x y : M), coe_fn B x y = coe_fn B y x

theorem sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_sym B) (x : M) (y : M) : coe_fn B x y = coe_fn B y x :=
  H x y

theorem is_refl {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_sym B) : refl_bilin_form.is_refl B :=
  fun (x y : M) (H1 : coe_fn B x y = 0) => H x y ▸ H1

theorem ortho_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_sym B) {x : M} {y : M} : bilin_form.is_ortho B x y ↔ bilin_form.is_ortho B y x :=
  refl_bilin_form.ortho_sym (is_refl H)

end sym_bilin_form

namespace alt_bilin_form

/-- The proposition that a bilinear form is alternating -/
def is_alt {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) :=
  ∀ (x : M), coe_fn B x x = 0

theorem self_eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (H : is_alt B) (x : M) : coe_fn B x x = 0 :=
  H x

theorem neg {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} (H : is_alt B₁) (x : M₁) (y : M₁) : -coe_fn B₁ x y = coe_fn B₁ y x := sorry

end alt_bilin_form

namespace bilin_form

/-- Given a pair of modules equipped with bilinear forms, this is the condition for a pair of
maps between them to be mutually adjoint. -/
def is_adjoint_pair {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) {M' : Type u_1} [add_comm_monoid M'] [semimodule R M'] (B' : bilin_form R M') (f : linear_map R M M') (g : linear_map R M' M) :=
  ∀ {x : M} {y : M'}, coe_fn B' (coe_fn f x) y = coe_fn B x (coe_fn g y)

theorem is_adjoint_pair.eq {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M'] {B' : bilin_form R M'} {f : linear_map R M M'} {g : linear_map R M' M} (h : is_adjoint_pair B B' f g) {x : M} {y : M'} : coe_fn B' (coe_fn f x) y = coe_fn B x (coe_fn g y) :=
  h

theorem is_adjoint_pair_iff_comp_left_eq_comp_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (F : bilin_form R M) (f : module.End R M) (g : module.End R M) : is_adjoint_pair B F f g ↔ comp_left F f = comp_right B g := sorry

theorem is_adjoint_pair_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M'] {B' : bilin_form R M'} : is_adjoint_pair B B' 0 0 := sorry

theorem is_adjoint_pair_id {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} : is_adjoint_pair B B 1 1 :=
  fun (x y : M) => rfl

theorem is_adjoint_pair.add {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M'] {B' : bilin_form R M'} {f : linear_map R M M'} {f' : linear_map R M M'} {g : linear_map R M' M} {g' : linear_map R M' M} (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B B' f' g') : is_adjoint_pair B B' (f + f') (g + g') := sorry

theorem is_adjoint_pair.sub {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] {B₁ : bilin_form R₁ M₁} {M₁' : Type u_2} [add_comm_group M₁'] [module R₁ M₁'] {B₁' : bilin_form R₁ M₁'} {f₁ : linear_map R₁ M₁ M₁'} {f₁' : linear_map R₁ M₁ M₁'} {g₁ : linear_map R₁ M₁' M₁} {g₁' : linear_map R₁ M₁' M₁} (h : is_adjoint_pair B₁ B₁' f₁ g₁) (h' : is_adjoint_pair B₁ B₁' f₁' g₁') : is_adjoint_pair B₁ B₁' (f₁ - f₁') (g₁ - g₁') := sorry

theorem is_adjoint_pair.smul {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {M₂' : Type u_3} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {B₂' : bilin_form R₂ M₂'} {f₂ : linear_map R₂ M₂ M₂'} {g₂ : linear_map R₂ M₂' M₂} (c : R₂) (h : is_adjoint_pair B₂ B₂' f₂ g₂) : is_adjoint_pair B₂ B₂' (c • f₂) (c • g₂) := sorry

theorem is_adjoint_pair.comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M'] {B' : bilin_form R M'} {f : linear_map R M M'} {g : linear_map R M' M} {M'' : Type u_4} [add_comm_monoid M''] [semimodule R M''] (B'' : bilin_form R M'') {f' : linear_map R M' M''} {g' : linear_map R M'' M'} (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B' B'' f' g') : is_adjoint_pair B B'' (linear_map.comp f' f) (linear_map.comp g g') := sorry

theorem is_adjoint_pair.mul {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} {f : module.End R M} {g : module.End R M} {f' : module.End R M} {g' : module.End R M} (h : is_adjoint_pair B B f g) (h' : is_adjoint_pair B B f' g') : is_adjoint_pair B B (f * f') (g' * g) := sorry

/-- The condition for an endomorphism to be "self-adjoint" with respect to a pair of bilinear forms
on the underlying module. In the case that these two forms are identical, this is the usual concept
of self adjointness. In the case that one of the forms is the negation of the other, this is the
usual concept of skew adjointness. -/
def is_pair_self_adjoint {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (F : bilin_form R M) (f : module.End R M) :=
  is_adjoint_pair B F f f

/-- The set of pair-self-adjoint endomorphisms are a submodule of the type of all endomorphisms. -/
def is_pair_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (F₂ : bilin_form R₂ M₂) : submodule R₂ (module.End R₂ M₂) :=
  submodule.mk (set_of fun (f : module.End R₂ M₂) => is_pair_self_adjoint B₂ F₂ f) sorry sorry sorry

@[simp] theorem mem_is_pair_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (F₂ : bilin_form R₂ M₂) (f : module.End R₂ M₂) : f ∈ is_pair_self_adjoint_submodule B₂ F₂ ↔ is_pair_self_adjoint B₂ F₂ f :=
  iff.refl (f ∈ is_pair_self_adjoint_submodule B₂ F₂)

theorem is_pair_self_adjoint_equiv {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {M₃' : Type u_5} [add_comm_group M₃'] [module R₃ M₃'] (B₃ : bilin_form R₃ M₃) (F₃ : bilin_form R₃ M₃) (e : linear_equiv R₃ M₃' M₃) (f : module.End R₃ M₃) : is_pair_self_adjoint B₃ F₃ f ↔
  is_pair_self_adjoint (comp B₃ ↑e ↑e) (comp F₃ ↑e ↑e) (coe_fn (linear_equiv.conj (linear_equiv.symm e)) f) := sorry

/-- An endomorphism of a module is self-adjoint with respect to a bilinear form if it serves as an
adjoint for itself. -/
def is_self_adjoint {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (B : bilin_form R M) (f : module.End R M) :=
  is_adjoint_pair B B f f

/-- An endomorphism of a module is skew-adjoint with respect to a bilinear form if its negation
serves as an adjoint. -/
def is_skew_adjoint {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] (B₁ : bilin_form R₁ M₁) (f : module.End R₁ M₁) :=
  is_adjoint_pair B₁ B₁ f (-f)

theorem is_skew_adjoint_iff_neg_self_adjoint {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁] (B₁ : bilin_form R₁ M₁) (f : module.End R₁ M₁) : is_skew_adjoint B₁ f ↔ is_adjoint_pair (-B₁) B₁ f f := sorry

/-- The set of self-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Jordan subalgebra.) -/
def self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) : submodule R₂ (module.End R₂ M₂) :=
  is_pair_self_adjoint_submodule B₂ B₂

@[simp] theorem mem_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (f : module.End R₂ M₂) : f ∈ self_adjoint_submodule B₂ ↔ is_self_adjoint B₂ f :=
  iff.rfl

/-- The set of skew-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Lie subalgebra.) -/
def skew_adjoint_submodule {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] (B₃ : bilin_form R₃ M₃) : submodule R₃ (module.End R₃ M₃) :=
  is_pair_self_adjoint_submodule (-B₃) B₃

@[simp] theorem mem_skew_adjoint_submodule {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] (B₃ : bilin_form R₃ M₃) (f : module.End R₃ M₃) : f ∈ skew_adjoint_submodule B₃ ↔ is_skew_adjoint B₃ f := sorry

end bilin_form

/-- The condition for the square matrices `A`, `A'` to be an adjoint pair with respect to the square
matrices `J`, `J₃`. -/
def matrix.is_adjoint_pair {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) :=
  matrix.mul (matrix.transpose A) J₃ = matrix.mul J A'

/-- The condition for a square matrix `A` to be self-adjoint with respect to the square matrix
`J`. -/
def matrix.is_self_adjoint {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) :=
  matrix.is_adjoint_pair J J A A

/-- The condition for a square matrix `A` to be skew-adjoint with respect to the square matrix
`J`. -/
def matrix.is_skew_adjoint {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) :=
  matrix.is_adjoint_pair J J A (-A)

@[simp] theorem is_adjoint_pair_to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) [DecidableEq n] : bilin_form.is_adjoint_pair (coe_fn matrix.to_bilin' J) (coe_fn matrix.to_bilin' J₃) (coe_fn matrix.to_lin' A)
    (coe_fn matrix.to_lin' A') ↔
  matrix.is_adjoint_pair J J₃ A A' := sorry

@[simp] theorem is_adjoint_pair_to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃] {n : Type w} [fintype n] {b : n → M₃} (hb : is_basis R₃ b) (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) [DecidableEq n] : bilin_form.is_adjoint_pair (coe_fn (matrix.to_bilin hb) J) (coe_fn (matrix.to_bilin hb) J₃)
    (coe_fn (matrix.to_lin hb hb) A) (coe_fn (matrix.to_lin hb hb) A') ↔
  matrix.is_adjoint_pair J J₃ A A' := sorry

theorem matrix.is_adjoint_pair_equiv {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) [DecidableEq n] (P : matrix n n R₃) (h : is_unit P) : matrix.is_adjoint_pair (matrix.mul (matrix.mul (matrix.transpose P) J) P)
    (matrix.mul (matrix.mul (matrix.transpose P) J) P) A A' ↔
  matrix.is_adjoint_pair J J (matrix.mul (matrix.mul P A) (P⁻¹)) (matrix.mul (matrix.mul P A') (P⁻¹)) := sorry

/-- The submodule of pair-self-adjoint matrices with respect to bilinear forms corresponding to
given matrices `J`, `J₂`. -/
def pair_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (J₃ : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  submodule.map (↑linear_map.to_matrix')
    (bilin_form.is_pair_self_adjoint_submodule (coe_fn matrix.to_bilin' J) (coe_fn matrix.to_bilin' J₃))

@[simp] theorem mem_pair_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] : A ∈ pair_self_adjoint_matrices_submodule J J₃ ↔ matrix.is_adjoint_pair J J₃ A A := sorry

/-- The submodule of self-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  pair_self_adjoint_matrices_submodule J J

@[simp] theorem mem_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] : A ∈ self_adjoint_matrices_submodule J ↔ matrix.is_self_adjoint J A := sorry

/-- The submodule of skew-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def skew_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  pair_self_adjoint_matrices_submodule (-J) J

@[simp] theorem mem_skew_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] : A ∈ skew_adjoint_matrices_submodule J ↔ matrix.is_skew_adjoint J A := sorry


-- https://github.com/leanprover-community/mathlib/issues/2794
import data.nat.prime
open nat
@[simp] lemma min_fac_eq_one_iff (n : ℕ) : min_fac n = 1 ↔ n = 1 := sorry
lemma min_fac_eq_two_iff (n : ℕ) : min_fac n = 2 ↔ 2 ∣ n :=
begin
  split,
  { sorry },
  { intro h,
    have ub := min_fac_le_of_dvd (le_refl 2) h,
    have lb := min_fac_pos n,
    -- If `interval_cases` and `norm_num` were already available here,
    -- this would be easy and pleasant.
    -- But they aren't, so it isn't.
    cases h : n.min_fac with m,
    { sorry },
    { cases m with m,
      { simp at h, subst h, rcases? h, /- goals accomplished -/
      /- Try this: rcases h with ⟨_ | _ | _ | _ | h_w, rfl⟩ -/
       },
      { cases m with m,
        { refl, },
        { rw h at ub,
          rcases? ub, /- goals accomplished -/
          /- Try this: rcases ub with _ | _ -/ } } } }
end
/-
tactic failed, result contains meta-variables
state:
no goals
-/


--Right nonassociative hoops in Lean
--Author: Peter Jipsen

set_option old_structure_cmd true

universe u
variables {α: Type u}
reserve infix ` ≼ `:50
class has_pre (α : Type u) := (pre : α → α → Prop)
infix ≼ := has_pre.pre

reserve infix ` ∧ ` : 60
class has_qmt (α: Type u) := (qmt : α → α → α)
infix ∧ := has_qmt.qmt
--local notation x ∧ y := (x/y)*y

-- Right residuated magmas
class RResMag(α: Type u) extends
has_mul α, has_div α, partial_order α, has_qmt α, has_pre α :=
(rres: ∀x y z:α, x*y ≤ z ↔ x ≤ z/y)
(qmt1: ∀x y:α,   (x ∧ y) = (x/y)*y)
(pre1: ∀x y:α,   x ≼ y ↔ x ∧ y = x)

lemma rres [RResMag α]: ∀x y z:α, x*y ≤ z ↔ x ≤ z/y := RResMag.rres

lemma qmt [RResMag α]: ∀x y:α, (x ∧ y) = (x/y)*y := RResMag.qmt1

@[simp] lemma L1_2L [RResMag α]: ∀x y:α, x/y*y ≤ x :=
assume x y:α,
have h: x/y ≤ x/y, from le_refl (x/y),
show    x/y*y ≤ x, from iff.mpr (rres (x/y) y x) h

lemma L1_2R [RResMag α]: ∀x y:α, x ≤ (x*y)/y :=
assume x y:α,
have h: x*y ≤ x*y, from le_refl (x*y),
show    x ≤ x*y/y, from iff.mp (rres x y (x*y)) h

lemma L1_3 [RResMag α]: ∀x y z:α, x ≤ y → x*z ≤ y*z :=
assume x y z:α,
  (assume h₀: x ≤ y,
     have h₁: y ≤ y*z/z, from L1_2R y z,
     have h₂: x ≤ y*z/z, from le_trans h₀ h₁,
     show   x*z ≤ y*z,   from iff.mpr (rres x z (y*z)) h₂)

lemma L1_4 [RResMag α]: ∀x y z:α, x ≤ y → x/z ≤ y/z :=
assume x y z:α,
  (assume h₀:       x ≤ y,
     have h₁: (x/z)*z ≤ x,   from L1_2L x z,
     have h₂: (x/z)*z ≤ y,   from le_trans h₁ h₀,
     show         x/z ≤ y/z, from iff.mp (rres (x/z) z y) h₂)

class RResMagEq(α: Type u) extends has_mul α, has_div α, partial_order α :=
(E1_2L: ∀x y:α, x/y*y ≤ x)
(E1_2R: ∀x y:α, x ≤ x*y/y)
(E1_3:  ∀x y z:α, x ≤ y → x*z ≤ y*z)
(E1_4:  ∀x y z:α, x ≤ y → x/z ≤ y/z)

lemma eqrres [RResMagEq α]: ∀x y z:α, x*y ≤ z ↔ x ≤ z/y :=
assume x y z:α,
  (iff.intro
    (assume h:   x*y ≤ z,
      have h1: x*y/y ≤ z/y, from (RResMagEq.E1_4 (x*y) z y) h,
      show         x ≤ z/y, from le_trans (RResMagEq.E1_2R x y) h1)
    (assume h:     x ≤ z/y,
      have h1:   x*y ≤ (z/y)*y, from (RResMagEq.E1_3 x (z/y) y) h,
      show       x*y ≤ z,       from le_trans h1 (RResMagEq.E1_2L z y)))

lemma L1_5 [RResMag α]: ∀x y:α, (x*y/y)*y = x*y :=
assume x y:α,
have h₁: (x*y/y)*y ≤ x*y, from L1_2L (x*y) y,
have h₂: x ≤ x*y/y,       from L1_2R x y,
have h₃: x*y ≤ (x*y/y)*y, from (L1_3 x (x*y/y) y) h₂,
show     (x*y/y)*y = x*y, from le_antisymm h₁ h₃

lemma L1_6 [RResMag α]: ∀x y:α, (x/y)*y/y = x/y :=
assume x y:α,
have h₁: x/y ≤ (x/y)*y/y, from L1_2R (x/y) y,
have h₂: x/y*y ≤ x,       from L1_2L x y,
have h₃: (x/y)*y/y ≤ x/y, from (L1_4 (x/y*y) x y) h₂,
show     (x/y)*y/y = x/y, from le_antisymm h₃ h₁

lemma L1_8 [RResMag α]: ∀x y:α, x*y ∧ y = x*y :=
assume x y:α,
calc
  x*y ∧ y = x*y/y*y : by rw qmt
      ... = x*y     : by rw L1_5

lemma L1_9 [RResMag α]: ∀x y:α, (x ∧ y)/y = x/y :=
assume x y:α,
calc
  (x ∧ y)/y = x/y*y/y : by rw qmt
        ... = x/y     : by rw L1_6

lemma L1_10 [RResMag α]: ∀x y:α, x ∧ y ≤ x :=
assume x y:α,
have h: x/y*y ≤ x, from L1_2L x y,
show x ∧ y ≤ x, from (qmt x y).symm ▸ h

lemma L1_11 [RResMag α]:  ∀x y z:α, x ∧ y ≤ z ↔ x/y ≤ z/y :=
assume x y z:α,
have h: x/y*y ≤ z ↔ x/y ≤ z/y, from rres (x/y) y z,
show  x ∧ y ≤ z ↔ x/y ≤ z/y, from (qmt x y).symm ▸ h

lemma L1_12 [RResMag α]:  ∀x y z:α, x ≤ y → x ∧ z ≤ y ∧ z :=
assume x y z:α,
  (assume h₀: x ≤ y,
     have h₁: x/z ≤ y/z, from (L1_4 x y z) h₀,
     have h₂: x/z*z ≤ y/z*z, from (L1_3(x/z)(y/z)z) h₁,
     have h₃: x ∧ z ≤ y/z*z, from (qmt x z).symm ▸ h₂,
     show     x ∧ z ≤ y ∧ z, from (qmt y z).symm ▸ h₃)

class PreMag (α: Type u) extends RResMag α :=
(refl: ∀x:α, x≼x)
(tran: ∀x y z:α, x≼y → y≼z → x≼z)

class Dtoid (α: Type u) extends has_mul α, has_div α, has_pre α, has_qmt α:=
(pre1: ∀x y:α,   x ≼ y ↔ x ∧ y = x)
(idem: ∀x:α, x ∧ x = x)
(dass: ∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))

lemma dass [Dtoid α]: ∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z) := Dtoid.dass

lemma L1_13 [PreMag α]:  ∀x y:α, x ≼ y ↔ x ∧ y = x := PreMag.pre1

lemma L1_14 [PreMag α]:  ∀x y:α, x*y ≼ y :=
assume x y:α,
have h: x*y ∧ y = x*y, from L1_8 x y,
show  x*y ≼ y, from iff.mpr (L1_13 (x*y) y) h

lemma L1_15 [PreMag α]:  ∀x y:α, x ∧ y ≼ y :=
assume x y:α,
have h: x/y*y ≼ y, from L1_14 (x/y) y,
show x ∧ y ≼ y, from (qmt x y).symm ▸ h

lemma L1a [PreMag α]: ∀x:α, x ∧ x = x :=
assume x:α,
have h: x≼x, from PreMag.refl x,
show x ∧ x = x, from iff.mp (PreMag.pre1 x x) h

lemma L1b [PreMag α]: ∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z) :=
assume x y z:α,
have h₁: x/(y/z*z)*(y/z*z) ≼ y/z*z, from L1_14 (x/(y/z*z)) (y/z*z),
have h₂: y/z*z ≼ z, from L1_14 (y/z) z,
have h₃: x/(y/z*z)*(y/z*z) ≼ z,
                       from (PreMag.tran (x/(y/z*z)*(y/z*z)) (y/z*z) z) h₁ h₂,
have h₄: x/(y ∧ z)*(y ∧ z) ≼ z, from (qmt y z).symm ▸ h₃,
have h₅: x ∧ (y ∧ z) ≼ z, from (qmt x (y ∧ z)).symm ▸ h₄,
show (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z),
                       from iff.mp (PreMag.pre1 (x ∧ (y ∧ z)) z) h₅

lemma L1c [Dtoid α]: ∀x:α, x ≼ x :=
assume x:α,
have h: x ∧ x = x, from Dtoid.idem x,
show x ≼ x, from iff.mpr (Dtoid.pre1 x x) h

lemma L1d [Dtoid α]: ∀x y z:α, x ≼ y → y ≼ z → x ≼ z :=
assume x y z:α,
  (assume h₀: x ≼ y,
    (assume h₁: y ≼ z,
     have h₂: x ∧ y = x, from iff.mp (Dtoid.pre1 x y) h₀,
     have h₃: y ∧ z = y, from iff.mp (Dtoid.pre1 y z) h₁,
     have h₄: x ∧ z = x, from
     calc
       x ∧ z = (x ∧ y) ∧ z : by rw h₂
         ... = (x ∧ (y ∧ z)) ∧ z : by rw h₃
         ... = x ∧ (y ∧ z)       : by rw dass
         ... = x ∧ y             : by rw h₃
         ... = x                 : by rw h₂,
     show x ≼ z, from iff.mpr (Dtoid.pre1 x z) h₄))

lemma L2a [RResMag α]:
(∀x y:α, x ≤ y → x ≼ y) → (∀x y:α, (x ∧ y) ∧ x = x ∧ y) :=
--Proof:
assume h: (∀x y:α, x ≤ y → x ≼ y),
  (assume x y:α,
     have h: x ∧ y ≼ x, from (h (x ∧ y) x) (L1_10 x y),
     show (x ∧ y) ∧ x = x ∧ y, from iff.mp (RResMag.pre1 (x ∧ y) x) h)

lemma L2b [RResMag α]: (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
→ (∀x y z:α, (x ∧ y) ∧ z = (x ∧ z) ∧ y) :=
assume h: (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y),
  (assume x y z:α,
    have h₁: (x ∧ y) ∧ z = ((x ∧ y) ∧ z) ∧ y, from calc
      (x ∧ y) ∧ z = ((x ∧ y) ∧ z) ∧ (x ∧ y)       : by rw L2a h.2
              ... = (((x ∧ y) ∧ z) ∧ (x ∧ y)) ∧ y : by rw (h.1)
              ... = ((x ∧ y) ∧ z) ∧ y             : by rw L2a h.2,
    have h₂: (x ∧ y) ∧ z ≤ x ∧ z, from (L1_12 (x ∧ y) x z) (L1_10 x y),
    have h₃: ((x ∧ y) ∧ z) ∧ y ≤ (x ∧ z) ∧ y, from (L1_12 ((x∧y)∧z) (x∧z) y) h₂,
    have h₄: ((x ∧ y) ∧ z) ≤ (x ∧ z) ∧ y, from h₁.symm ▸ h₃,

    have h₅: (x ∧ z) ∧ y = ((x ∧ z) ∧ y) ∧ z, from calc
      (x ∧ z) ∧ y = ((x ∧ z) ∧ y) ∧ (x ∧ z)       : by rw L2a h.2
              ... = (((x ∧ z) ∧ y) ∧ (x ∧ z)) ∧ z : by rw (h.1)
              ... = ((x ∧ z) ∧ y) ∧ z             : by rw L2a h.2,
    have h₆: (x ∧ z) ∧ y ≤ x ∧ y, from (L1_12 (x ∧ z) x y) (L1_10 x z),
    have h₇: ((x ∧ z) ∧ y) ∧ z ≤ (x ∧ y) ∧ z, from (L1_12 ((x∧z)∧y) (x∧y) z) h₆,
    have h₈: ((x ∧ z) ∧ y) ≤ (x ∧ y) ∧ z, from h₅.symm ▸ h₇,
    show (x ∧ y) ∧ z = (x ∧ z) ∧ y, from le_antisymm h₄ h₈)

variables (R: α→α → Prop)

lemma L3_1 [RResMag α]: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x)
→ (∀x y:α, R x y → x ≤ y) :=
assume h: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x),
assume x y:α,
assume h₀: R x y,
have h₁: x = y ∧ x, from iff.mp (h.2.2.2 x y) h₀,
show x ≤ y, from h₁.symm ▸ (L1_10 y x)

#print L3_1

lemma L3_2 [RResMag α]: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x)
→ (∀x y:α, R x y ↔ y/x = x/x) :=
assume h: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x),
assume x y:α,
iff.intro
  (assume h₀: R x y,
  have x = y ∧ x, from iff.mp (h.2.2.2 x y) (by assumption),
  have x = y/x*x, from (RResMag.qmt1 y x) ▸ this,
  have y/x*x ≤ x, from le_of_eq this.symm,
  have y/x ≤ x/x, from iff.mp (rres (y/x) x x) this,
  have x ≤ y,     from L3_1 R h x y h₀,
  have x ∧ x ≤ y, from (h.1 x).symm ▸ this,
  have x/x*x ≤ y, from (RResMag.qmt1 x x) ▸ this,
  have x/x ≤ y/x, from iff.mp (rres (x/x) x y) this,
  show y/x = x/x, from le_antisymm (by assumption) this)
  (assume h₀: y/x = x/x,
  have y/x*x = x/x*x, by rw h₀,
  have y/x*x = x ∧ x, from (RResMag.qmt1 x x).symm ▸ this,
  have y ∧ x = x ∧ x, from (RResMag.qmt1 y x).symm ▸ this,
  have y ∧ x = x, from eq.trans this (h.1 x),
  show R x y,     from iff.mpr (h.2.2.2 x y) this.symm)

lemma L3_3 [RResMag α]: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x)
→ (∀x y z:α, R x y → R y z → R x z) :=
assume h: (∀x:α, x ∧ x = x)
/\ (∀x y z:α, (x ∧ (y ∧ z)) ∧ z = x ∧ (y ∧ z))
/\ (∀x y:α, x ≤ y → x ≼ y)
/\ (∀x y:α, R x y ↔ x = y ∧ x),
assume x y z:α,
assume h₀: R x y,
assume h₁: R y z,
have x ≤ y, from L3_1 R h x y h₀,
have x ≼ y, from (h.2.2.1 x y) this,
have h₂: x ∧ y = x, from iff.mp (RResMag.pre1 x y) this,
have h₃: z ∧ y = y, from (iff.mp (h.2.2.2 y z) h₁).symm,
have h₄: y ∧ x = x, from (iff.mp (h.2.2.2 x y) h₀).symm,
have h₅: z ∧ x = x, from calc
  z ∧ x = z ∧ (x ∧ y) : by rw h₂
    ... = (z ∧ (x ∧ y)) ∧ y : by rw h.2.1
    ... = (z ∧ x) ∧ y : by rw h₂
    ... = (z ∧ y) ∧ x : by rw L2b (and.intro h.2.1 h.2.2.1)
    ... = y ∧ x       : by rw h₃
    ... = x           : by rw h₄,
show R x z, from iff.mpr (h.2.2.2 x z) h₅.symm


import data.vector
import .for_mathlib

--------------- lang ---------------
section
universe v
structure lang := (op : ℕ → Type v)

namespace lang
instance : has_coe_to_fun lang := ⟨_,op⟩
end lang
end

--------------- ralg ---------------
section
universes v u
structure ralg (L : lang.{v}) :=
(carrier : Type u)
(appo {n} : L n → vector carrier n → carrier)

namespace ralg
instance {L} : has_coe_to_sort (ralg L) := ⟨_,carrier⟩
end ralg
end

notation `applyo` := ralg.appo _

----------- terms -----------------
section
universes v
namespace lang
inductive term (L : lang.{v}) : ℕ → ℕ → Type v
| of {n} : L n → term n 1
| proj {m n} : (fin m → fin n) → term n m
| comp {a b c} : term a b → term b c → term a c
| liftl {a b c} : term a b → term (a + c) (b + c)
| liftr {a b c} : term a b → term (c + a) (c + b)
end lang
end

def applyt {L : lang} {A : ralg L} {m n} (t : L.term m n) : vector A m → vector A n := lang.term.rec_on t
  (λ _ t as, vector.of $ applyo t as)
  (λ _ _, vector.proj)
  (λ _ _ _ _ _ f g, g ∘ f)
  (λ _ _ _ _, vector.liftl)
  (λ _ _ _ _, vector.liftr)

------------------- rules -------------------------
structure rules (L : lang) :=
(cond {m n} : L.term m n → L.term m n → Prop)

namespace rules
instance {L} : has_coe_to_fun (rules L) := ⟨_,cond⟩
end rules

-----------------  ualg --------------------------
structure ualg (L : lang) (R : rules L) extends ralg L :=
(cond_eq {m n} {t1 t2 : L.term m n} {as : vector carrier m} : R t1 t2 → applyt t1 as = applyt t2 as)

namespace ualg
instance {L} {R} : has_coe_to_sort (ualg L R) := ⟨_,λ A, A.carrier⟩
end ualg

namespace ualg
def raw {L} {R} : ualg L R → ralg L := to_ralg
end ualg

------------------ langHom -----------------
structure langHom (L1 : lang) (L2 : lang) := (map_op {n} : L1 n → L2 n)

infixr ` →# `:25 := langHom

namespace langHom
instance {L1} {L2} : has_coe_to_fun (L1 →# L2) := ⟨_,map_op⟩
end langHom

namespace lang.term
variables {L1 : lang} {L2 : lang} (ι : L1 →# L2)
include ι
def mapt {m n} (t : L1.term m n) : L2.term m n := lang.term.rec_on t
  (λ _ t, of $ ι t)
  (λ _ _, proj)
  (λ _ _ _ _ _, comp)
  (λ _ _ _ _, liftl)
  (λ _ _ _ _, liftr)

end lang.term

------------------- rulesHom ------------------
structure rulesHom {L1 : lang} {L2 : lang} (R1 : rules L1) (R2 : rules L2) :=
(lhom : L1 →# L2)
(map_cond {m n} {t1 t2 : L1.term m n} : R1 t1 t2 → R2 (t1.mapt lhom) (t2.mapt lhom))

infixr ` →$ `:25 := rulesHom

-------------------- algHom's ------------------
structure ralgHom {L : lang} (A : ralg L) (B : ralg L) :=
(to_fn : A → B)
(applyo_map {n} {t : L n} {as : vector A n}: applyo t (as.map to_fn) = to_fn (applyo t as))
def ualgHom {L : lang} {R1 R2 : rules L} (A : ualg L R1) (B : ualg L R2) := ralgHom A.raw B.raw
def ralgualgHom {L : lang} {R : rules L} (A : ralg L) (B : ualg L R) := ralgHom A B.raw
def ualgralgHom {L : lang} {R : rules L} (A : ualg L R) (B : ralg L) := ralgHom A.raw B

namespace ralgHom
instance {L} {A : ralg L} {B : ralg L} : has_coe_to_fun (ralgHom A B) := ⟨_,to_fn⟩
end ralgHom
namespace ualgHom
instance {L} {R1 R2 : rules L} {A : ualg L R1} {B : ualg L R2} : has_coe_to_fun (ualgHom A B) := ⟨_,λ f, f.to_fn⟩
end ualgHom
namespace ralgualgHom
instance {L} {R : rules L} {A : ralg L} {B : ualg L R} : has_coe_to_fun (ralgualgHom A B) := ⟨_,λ f, f.to_fn⟩
end ralgualgHom
namespace ualgralgHom
instance {L} {R : rules L} {A : ualg L R} {B : ralg L} : has_coe_to_fun (ualgralgHom A B) := ⟨_,λ f, f.to_fn⟩
end ualgralgHom

infixr ` →% `:25 := ralgHom
infixr ` →% `:25 := ualgHom
infixr ` →% `:25 := ralgualgHom
infixr ` →% `:25 := ualgralgHom

---------------- theorems abouts homs -----------

namespace ralgHom
variables {L : lang} {A : ralg L} {B : ralg L}
@[ext]
theorem ext (f g : A →% B) : ⇑f = g → f = g := λ hyp, by {cases f, cases g, simpa}
end ralgHom

namespace ralg

variables {L : lang} {A : ralg L} {B : ralg L}

/-
A ralg hom commutes with applyo.
-/
theorem applyo_map {n} (f : A →% B) (t : L n) (as : vector A n) :
  applyo t (as.map f) = f (applyo t as) := by apply ralgHom.applyo_map

/-
A ralg hom commutes with applyt.
-/
theorem applyt_map {m n} (f : A →% B) (t : L.term m n) (as : vector A m) :
  applyt t (as.map f) = (applyt t as).map f :=
begin
  induction t with _ _ _ _ _ _ _ _ _ _ h1 h2 _ _ _ _ h3 _ _ _ _ h4,
  { change vector.of _ = _,
    rw [applyo_map, ←vector.map_of],
    refl },
  { change vector.proj _ _ = vector.map _ (vector.proj _ _),
    rw vector.map_proj },
  { change (applyt _ (applyt _ _)) = _,
    rw [h1,h2], refl },
  { change _ = vector.map f (vector.append (applyt _ _) _),
    rw vector.map_append,
    rw ←h3,
    change vector.append (applyt _ _) _ = _,
    congr,
    { rw vector.map_init },
    { rw vector.map_last } },
  { change _ = vector.map f (vector.append _ (applyt _ _)),
    rw vector.map_append,
    rw ←h4,
    change vector.append _ (applyt _ _) = _,
    congr,
    { rw vector.map_init },
    { rw vector.map_last } },
end

end ralg

--------------------- composition -------------------------

namespace ralgHom
variables {L : lang} {A : ralg L} {B : ralg L} {C : ralg L} {D : ralg L}
def comp : (A →% B) → (B →% C) → (A →% C) := λ f g,
{ to_fn := g ∘ f,
  applyo_map := λ n t as, by rw ←vector.map_map; simp only [ralg.applyo_map] }

theorem comp_assoc {f : A →% B} {g : B →% C} {h : C →% D} : (f.comp g).comp h = f.comp (g.comp h) := rfl

end ralgHom

-------------------- forget_along -----------------------
/-
Here we construct some forgetful functors.
-/

namespace ralg
variables {L0 : lang} {L : lang} (ι : L0 →# L) (A : ralg L)
include ι A
def forget_along : ralg L0 :=
{ carrier := A,
  appo := λ n t, applyo (ι t) }

end ralg

notation A `{`:1000 ι `}`:1000 := ralg.forget_along ι A

namespace ralg
variables {L0 : lang} {L : lang} (ι : L0 →# L)
def cast {A : ralg L} : A → A{ι} := id
def uncast {A : ralg L} : A{ι} → A := id
include ι

theorem applyt_mapt {m n} {A : ralg L} (t : L0.term m n) (as : vector (A{ι}) m):
  applyt t as = vector.map (cast ι) (applyt (t.mapt ι) (as.map (uncast ι))) :=
begin
  simp only [cast, uncast, vector.map_id],
  induction t with _ _ _ _ _ _ _ _ _ _ h1 h2 _ _ _ _ h3 _ _ _ _ h4,
  { refl },
  { refl },
  { change applyt _ (applyt _ _) = _,
    rw [h1,h2],
    refl },
  { change vector.append (applyt _ _) _ = _,
    rw h3,
    refl },
  { change vector.append _ (applyt _ _) = _,
    rw h4,
    refl },
end

end ralg

namespace ualg
variables {L0 : lang} {L : lang} {R0 : rules L0} {R : rules L}
variables (ι : R0 →$ R) (A : ualg _ R)
include ι A
def forget_along : ualg _ R0  :=
{ cond_eq := λ m n t1 t2 as h,
  begin
    simp_rw ralg.applyt_mapt,
    apply congr_arg,
    apply A.cond_eq,
    apply ι.map_cond,
    assumption,
  end,
  ..show ralg L0, by exact A.raw{ι.lhom} }
end ualg

notation A `⦃`:1000 ι `⦄`:1000 := ualg.forget_along ι A

example {L0 : lang} {L : lang} {R0 : rules L0} {R : rules L}
  (ι : R0 →$ R) (A : ualg _ R) : A⦃ι⦄.raw = A.raw{ι.lhom} := rfl

----------------- forget_along for morphisms ----------------------

namespace ralgHom

variables {L0 : lang} {L1 : lang} (ι : L0 →# L1)
variables {A : ralg L1} {B : ralg L1}

def forget_along (f : A →% B) : A{ι} →% B{ι} :=
{ to_fn := f,
  applyo_map := λ n t as, by {erw ralg.applyo_map, refl} }

end ralgHom

notation A `{%`:1000 ι `}`:1000 := ralgHom.forget_along ι A


import algebra.ring.basic
import tactic
set_option old_structure_cmd true

/-- A type endowed with `0`, `1` and `+` is an additive commutative monoid with one,
if it admits an injective map that preserves `0`, `1` and `+` to an additive commutative monoid with
one. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.add_comm_monoid_with_one {M₁ M₂} [has_zero M₁] [has_one M₁] [has_add M₁] [has_smul ℕ M₁]
  [has_nat_cast M₁] [add_comm_monoid_with_one M₂] (f : M₁ → M₂) (hf : function.injective f) (zero : f 0 = 0)
  (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x)
  (nat_cast : ∀ n : ℕ, f n = n) :
  add_comm_monoid_with_one M₁ :=
{ ..hf.add_monoid_with_one f zero one add nsmul nat_cast, ..hf.add_comm_monoid f zero add nsmul }

universes u

@[protect_proj, ancestor add_monoid_with_one comm_monoid]
class wheel (α : Type u) extends add_comm_monoid_with_one α, comm_monoid α :=
(div : α → α)
(div_invol : ∀ x, div (div x) = x)
(div_mul_distrib : ∀ x y, div (x * y) = div x * div y)
(add_distrib_mul : ∀ x y z, (x + y) * z + (0 : α) * z = x * z + y * z)
(add_distrib_div : ∀ x y z, (x + y * z) * div y = x * div y + z + (0 : α) * y)
(zero_mul : (0 : α) * (0 : α) = 0)
(add_zero_mul : ∀ x y z, (x + (0 : α) * y) * z = x * z + (0 : α) * y)
(div_add_zero : ∀ x y, div (x + (0 : α) * y) = div x + 0 * y)
(add_bot : ∀ x, 0 * div 0 + x = (0 : α) * div 0)

attribute [simp] wheel.div_invol wheel.div_mul_distrib wheel.add_distrib_mul wheel.zero_mul wheel.add_bot

-- localized "notation (name := wheel.bot) `⊥` := (0 * wheel.div 0 : wheel)" in wheel
-- localized "notation (name := wheel.infinity) `∞` := (wheel.div 0 : wheel)" in wheel
-- localized "prefix `/`:(std.prec.max + 4) := wheel.div" in wheel
prefix `/`:(std.prec.max + 4) := wheel.div
notation (name := wheel.infinity) `∞w` := (wheel.div 0)
notation (name := wheel.bot) `⊥w` := (0 * ∞w)

namespace wheel

variables {W : Type u} [wheel W]

lemma zero_mul_add : ∀ (x y : W), 0 * (x + y) = 0 * x + 0 * y :=
begin
  intros x y,
	rw mul_comm,
	nth_rewrite 1 mul_comm,
	nth_rewrite 2 mul_comm,
	simpa using wheel.add_distrib_mul x y 0,
end

@[simp]
lemma div_one_eq_one : /(1 : W) = 1 :=
begin
	calc /(1 : W)
	    = (1 : W) * /(1 : W) : (one_mul _).symm
	... = /(/(1 : W)) * /(1 : W) : by rw wheel.div_invol
	... = /(/(1 : W) * 1) : by rw wheel.div_mul_distrib
	... = /(/(1 : W)) : by rw mul_one
	... = 1 : wheel.div_invol _,
end

lemma zero_mul_mul_eq_zero_mul_add_zero_mul : ∀ (x y : W), 0 * x + 0 * y = 0 * x * y :=
begin
	intros x y,
	rw (wheel.add_zero_mul 0 y x).symm,
  rw [zero_add, mul_assoc],
	nth_rewrite 1 mul_comm,
	rwa ← mul_assoc,
end

lemma bot_mul : ∀ (x : W), ⊥w * x = ⊥w :=
begin
	intro x,
	rw ← zero_mul_mul_eq_zero_mul_add_zero_mul ∞w x,
	exact wheel.add_bot (0 * x),
end

lemma div_self : ∀ (x : W), x * /x = 1 + 0 * x * /x :=
begin
	intro x,
	have := wheel.add_distrib_div 0 x 1,
	rw [zero_add, mul_one] at this,
	rw [this, add_assoc, add_comm, add_assoc],
	rwa zero_mul_mul_eq_zero_mul_add_zero_mul,
end

lemma mul_cancel : ∀ (x y z : W), x * z = y * z → x + 0 * z * /z = y + 0 * z * /z :=
begin
	intros x y z h,
	have : x * z * /z = y * z * /z := congr_arg (λ p, p * /z) h,
	rw [mul_assoc, mul_assoc] at this,
	rw div_self z at this,
	rw [mul_comm, mul_comm y _, mul_assoc] at this,
	rw [wheel.add_zero_mul 1 _ x, wheel.add_zero_mul 1 _ y, one_mul, one_mul] at this,
	rwa mul_assoc,
end

lemma zero_eq_one_imp_one_eq_bot : 0 = (1 : W) → (1 : W) = ⊥w :=
begin
	intro h,
	calc 1
	    = 1 * 1 : (mul_one 1).symm
	... = 1 * /(1 : W) : by rw div_one_eq_one
	... = 0 * /0 : by rw h,
end

lemma zero_eq_infty_imp_zero_eq_bot : (0 : W) = ∞w → (0 : W) = ⊥w :=
begin
	intro h,
	calc 0
		  = 0 * 0 : wheel.zero_mul.symm
	... = 0 * /(0 : W) : by rw ← h,
end

lemma zero_eq_bot_imp_eq_bot : (0 : W) = ⊥w → ∀ (x : W), x = ⊥w :=
begin
	intros h x,
	calc x
			= 0 + x : (zero_add x).symm
	... = 0 * /0 + x : by rw ← h
	... = 0 * /0 : wheel.add_bot _,
end

lemma one_eq_infty_imp_one_eq_bot : (1 : W) = ∞w → (1 : W) = ⊥w :=
begin
	intro h,
	calc (1 : W)
	    = 1 * /1 : by rw [one_mul, div_one_eq_one]
	... = /0 * /(/0) : by rw h
	... = 0 * /0 : by rw [wheel.div_invol, mul_comm],
end

lemma one_eq_bot_imp_eq_bot : (1 : W) = ⊥w → ∀ (x : W), x = ⊥w :=
begin
	intros h x,
	calc x
			= 1 * x : (one_mul x).symm
	... = 0 * /0 * x : by rw h
	... = 0 * /0 : bot_mul x,
end

lemma bot_eq_infinity_imp_eq_bot : (∞w : W) = ⊥w → ∀ (x : W), x = ⊥w :=
begin
	intros h x,
	calc x
			= 0 + x : (zero_add x).symm
	... = /(/0) + x : by rw wheel.div_invol
	... = /(0 * /0) + x : by rw ← h
	... = 0 * /(0) + x : by rw [wheel.div_mul_distrib, wheel.div_invol, mul_comm]
	... = 0 * /0 : wheel.add_bot _,
end

lemma zero_one_bot_infinity_unique : ((0 : W) = 1) ∨ ((0 : W) = ∞w) ∨ ((0 : W) = ⊥w) ∨ ((1 : W) = ∞w) ∨ ((1 : W) = ⊥w) ∨ ((∞w : W) = ⊥w) → ∀ (x y : W), x = y :=
begin
	intro h,
	suffices : ∀ x, x = (0 : W) * /0,
	{ intros x y, exact (this x).trans (this y).symm, },
	obtain (h | h | h | h | h | h) := h,
	{ exact one_eq_bot_imp_eq_bot (zero_eq_one_imp_one_eq_bot h), },
	{ exact zero_eq_bot_imp_eq_bot (zero_eq_infty_imp_zero_eq_bot h), },
	{ exact zero_eq_bot_imp_eq_bot h, },
	{ exact one_eq_bot_imp_eq_bot (one_eq_infty_imp_one_eq_bot h), },
	{ exact one_eq_bot_imp_eq_bot h, },
	{ exact bot_eq_infinity_imp_eq_bot h, }
end

-- class unit (α : Type u) [wheel α] (x : α) :=
-- (inverse : α)
-- (mul_inverse : x * inverse = 1)

lemma inverse_div_rel (x : W) [invertible x] : ⅟ x + 0 * /x = /x + 0 * ⅟ x :=
begin
	calc ⅟ x + 0 * /x
	    = ⅟ x * /(x * ⅟ x) + 0 * /x : by rw [mul_inv_of_self, div_one_eq_one, mul_one]
	... = /x * (⅟ x * /(⅟ x)) + 0 * /x : by { rw [wheel.div_mul_distrib], nth_rewrite 1 mul_comm, rw [← mul_assoc, mul_comm], }
	... = /x + 0 * ⅟ x * /(x * ⅟ x) : by { rw [div_self, mul_comm, wheel.add_distrib_mul, one_mul, wheel.div_mul_distrib], nth_rewrite 5 mul_comm, rw ← mul_assoc, }
	... = /x + 0 * ⅟ x : by rw [mul_inv_of_self, div_one_eq_one, mul_one],
end

lemma inverse_eq_div_add_zero_mul_inverse_self_div (x : W) [invertible x] : ⅟ x = /x + 0 * ⅟ x * /(⅟ x) :=
begin
	rw [← zero_mul_mul_eq_zero_mul_add_zero_mul, ← add_assoc, ← inverse_div_rel, add_assoc, zero_mul_mul_eq_zero_mul_add_zero_mul, mul_assoc, ← wheel.div_mul_distrib, mul_inv_of_self, div_one_eq_one, mul_one, add_zero],
end

lemma div_eq_mul_add_self_div (x : W) [invertible x] : /x = ⅟ x + 0 * x * /x :=
begin
	rw ← zero_mul_mul_eq_zero_mul_add_zero_mul,
	nth_rewrite 1 add_comm,
	rw [← add_assoc, inverse_div_rel, add_assoc, zero_mul_mul_eq_zero_mul_add_zero_mul, mul_assoc],
	nth_rewrite 1 mul_comm,
	rw [mul_inv_of_self, mul_one, add_zero],
end

def zero_mul_self_and_div_self_imp_unit : ∀ x : W, (0 * x = 0 ∧ 0 * /x = 0) → invertible x :=
λ x hx, ⟨/x, by rw [mul_comm, wheel.div_self, hx.1, hx.2, add_zero], by rw [wheel.div_self, hx.1, hx.2, add_zero]⟩

@[reducible]
def 𝓡 (α : Type u) [wheel α] := {x : α // (0 : α) * x = 0}

namespace 𝓡

instance : has_zero (𝓡 W) :=
{ zero := ⟨0, wheel.zero_mul⟩ }

instance : has_one (𝓡 W) :=
{ one := ⟨1, mul_one 0⟩ }

instance : has_add (𝓡 W) :=
{ add := λ x y, ⟨x.1 + y.1,
		begin
			calc 0 * (x.1 + y.1)
					= (x.1 + y.1) * 0 + 0 * 0 : by rw [wheel.zero_mul, add_zero, mul_comm]
			... = x.1 * 0 + y.1 * 0 : wheel.add_distrib_mul _ _ _
			... = 0 : by rw [mul_comm, x.2, mul_comm, y.2, add_zero],
		end⟩, }

instance : has_smul ℕ (𝓡 W) :=
{ smul := λ n x, ⟨n • x.1, by {
	induction n,
	{ rw [zero_nsmul, wheel.zero_mul] },
	{ rw [succ_nsmul],
		set nx : 𝓡 W := ⟨n_n • x.val, n_ih⟩,
		exact (x + nx).prop, } }⟩ }

instance : has_nat_cast (𝓡 W) :=
{ nat_cast := λ N, ⟨N, by {
	induction N,
	{ rw [nat.cast_zero, wheel.zero_mul] },
	{ rw nat.cast_succ,
		exact (⟨N_n, N_ih⟩ + 1 : 𝓡 W).prop, } }⟩ }

instance : add_comm_monoid_with_one (𝓡 W) :=
subtype.coe_injective.add_comm_monoid_with_one _ rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance : has_mul (𝓡 W) :=
{ mul := λ x y, ⟨x.1 * y.1,
		begin
			rw [← mul_assoc, ← wheel.zero_mul_mul_eq_zero_mul_add_zero_mul],
			dsimp, rw [x.prop, y.prop, add_zero],
		end⟩, }

instance : has_pow (𝓡 W) ℕ :=
{ pow := λ x n, ⟨x.1 ^ n,
		begin
			induction n,
			{ rw [pow_zero, mul_one], },
			{ rw [pow_succ, ← mul_assoc, ← wheel.zero_mul_mul_eq_zero_mul_add_zero_mul, n_ih],
				dsimp, rw [x.prop, add_zero], }
		end⟩ }

instance : comm_monoid (𝓡 W) :=
subtype.coe_injective.comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

@[simp, norm_cast] lemma coe_zero : ((0 : 𝓡 W) : W) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : 𝓡 W) : W) = 1 := rfl
@[simp, norm_cast] lemma coe_add (a b : 𝓡 W) : (↑(a + b) : W) = a + b := rfl
@[simp, norm_cast] lemma coe_nsmul (n : ℕ) (a : 𝓡 W) : (↑(n • a) : W) = n • a := rfl
@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : 𝓡 W) : W) = n := rfl
@[simp, norm_cast] lemma coe_mul (a b : 𝓡 W) : (↑(a * b) : W) = a * b := rfl
-- @[simp, norm_cast] lemma coe_pow (a : 𝓡 W) ℕ : (↑(a ^ n) : W) = a ^ n := rfl

instance : comm_semiring (𝓡 W) :=
{ left_distrib :=
		begin
			intros a b c,
			ext, rw [coe_mul, coe_add, coe_add, coe_mul, coe_mul],
			nth_rewrite 1 mul_comm, nth_rewrite 2 mul_comm,
			rw [← wheel.add_distrib_mul, a.prop, add_zero, mul_comm],
		end,
  right_distrib :=
		begin
			intros a b c,
			ext, rw [coe_mul, coe_add, coe_add, coe_mul, coe_mul],
			rw [← wheel.add_distrib_mul, c.prop, add_zero],
		end,
  zero_mul :=
		begin
			intro a,
			ext, rw [coe_zero, coe_mul, coe_zero, a.prop],
		end,
  mul_zero :=
		begin
			intro a,
			ext,
			rw [mul_comm, coe_zero, coe_mul, coe_zero, a.prop],
		end,
  ..𝓡.add_comm_monoid_with_one, ..𝓡.comm_monoid }

end 𝓡

@[reducible]
def 𝓢 (α : Type u) [wheel α] := {x : α // 0 * x = 0 ∧ 0 * /x = 0}

namespace 𝓢

instance : has_one (𝓢 W) :=
{ one := ⟨1, mul_one 0, by rw [div_one_eq_one, mul_one] ⟩ }

instance : has_mul (𝓢 W) :=
{ mul := λ x y, ⟨x.1 * y.1,
		begin
			dsimp, split,
			{ rw [← mul_assoc, ← wheel.zero_mul_mul_eq_zero_mul_add_zero_mul, x.prop.1, y.prop.1, add_zero], },
			{ rw [wheel.div_mul_distrib, ← mul_assoc, x.prop.2, y.prop.2] }
		end⟩ }

instance : has_pow (𝓢 W) ℕ :=
{ pow := λ x n, ⟨x.1 ^ n,
		begin
			induction n,
			{ simp only [pow_zero, mul_one, div_one_eq_one, and_self], },
			{ rw pow_succ, dsimp at n_ih ⊢, rw [← mul_assoc, wheel.div_mul_distrib, ← mul_assoc, x.prop.1, x.prop.2, n_ih.1, n_ih.2], exact ⟨rfl, rfl⟩, }
		end⟩ }

instance : comm_monoid (𝓢 W) :=
subtype.coe_injective.comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance : has_inv (𝓢 W) :=
{ inv := λ x, ⟨/x.val, x.prop.2, by { rw wheel.div_invol, exact x.prop.1, }⟩ }

@[simp, norm_cast] lemma coe_one : ((1 : 𝓢 W) : W) = 1 := rfl
@[simp, norm_cast] lemma coe_mul (a b : 𝓢 W) : (↑(a * b) : W) = a * b := rfl
@[simp, norm_cast] lemma coe_inv (a : 𝓢 W) : (↑(a⁻¹) : W) = /a := rfl

instance : comm_group (𝓢 W) :=
{ mul_left_inv :=
		begin
			intro a,
			ext, simp only [coe_mul, coe_inv, coe_one],
			rw [mul_comm, wheel.div_self, a.prop.1, a.prop.2, add_zero],
		end,
	..𝓢.comm_monoid, ..𝓢.has_inv }

end 𝓢

end wheel

-- wheel with an element that behaves as -1
class sub_wheel (α : Type u) extends wheel α :=
(minus_one : α)
(minus_one_plus_one : 1 + minus_one = 0)

attribute [simp] sub_wheel.minus_one_plus_one

prefix (name := sub_wheel.neg) `-`:(std.prec.max + 5) := sub_wheel.mul sub_wheel.minus_one

namespace sub_wheel

variables {W : Type u} [sub_wheel W]

lemma add_neg_self : ∀ x : W, x + -x = 0 * x * x :=
begin
	intro x,
	calc x + minus_one * x
	    = 1 * x + minus_one * x : by rw one_mul
	... = (1 + minus_one) * x + 0 * x : by rw ← add_distrib_mul
	... = 0 * x + 0 * x : by rw minus_one_plus_one
	... = 0 * x * x : by rw wheel.zero_mul_mul_eq_zero_mul_add_zero_mul,
end

end sub_wheel


/-! # Useful helpers -/

namespace Cat

/-- `𝕂`onstant combinator: `𝕂 val arg` returns `val` for all `arg`s. -/
abbrev 𝕂
  {α : Sort u}
  {β : Sort v}
  (val : β)
: α → β :=
  fun _ => val

/-! ## Congruence helpers -/
section congr

  class Congr
    (α : Sort u_α)
    (β : Sort u_β)
    (γ : Sort u_γ)
    [instα : HasEquiv α]
    [instβ : HasEquiv β]
    [instγ : HasEquiv γ]
    -- [Trans instγ.Equiv instγ.Equiv instγ.Equiv]
    (compose : α → β → γ)
  where
    left
      {f f' : outParam α}
      (g : β)
    : f ≈ f'
    → compose f g ≈ compose f' g

    right
      (f : α)
      {g g' : outParam β}
    : g ≈ g'
    → compose f g ≈ compose f g'

  theorem Congr.both
    [instα : HasEquiv α]
    [instβ : HasEquiv β]
    [instγ : HasEquiv γ]
    [Trans instγ.Equiv instγ.Equiv instγ.Equiv]
    [C : Congr α β γ compose]
  : {f f' : α}
  → {g g' : β}
  → f ≈ f'
  → g ≈ g'
  → compose f g ≈ compose f' g'
  :=
    fun {_f f' g _g'} h_f h_g =>
      let lft :=
        C.left g h_f
      let rgt :=
        C.right f' h_g
      trans lft rgt
end congr


import myhelper.char
import myhelper.perfect
import myhelper.mypoly.basic
import tactic

noncomputable theory

namespace monic_quad_poly

lemma disc_zero_implies_has_multiple_root
{K : Type*} [field K] (f : monic_quad_poly K) (hperfect : ring_char K = 2 → my_perfect_field K):
f.disc = 0 → f.has_multiple_root :=
begin
  unfold disc,
  intro hdisc,
  by_cases hchar2 : ring_char K = 2, {
    replace hperfect : nth_power_surjective K 2 := by {
      have h := hperfect hchar2,
      simp [my_perfect_field, hchar2] at h,
      exact h,
    },
    ring_char2 at hdisc,
    cases hperfect (-f.b) with x hx,
    use x,
    simp [is_multiple_root, eval_at,
      eval_dx_at, hdisc, hx],
    ring_char2,
  },
  replace hdisc := sub_eq_zero.1 hdisc,
  replace hchar2 := prime_neq_char_is_non_zero K 2 (by norm_num) hchar2,
  norm_cast at hchar2,
  use (-f.a/2),
  simp only [is_multiple_root, eval_at, eval_dx_at],
  split, {
    field_simp [pow_succ, hchar2],
    transitivity -2*f.a^2 + 8*f.b,
    { norm_num, ring, },
    rw hdisc, ring,
  },
  field_simp [hchar2],
  ring,
end

end monic_quad_poly

namespace monic_cubic_poly

lemma eval_dx_at_char3 {K : Type*} [comm_ring K] (hchar3 : ring_char K = 3)
(f : monic_cubic_poly K) (x : K)
: f.eval_dx_at x = 2*f.a*x + f.b :=
sub_eq_zero.1 begin
  unfold eval_dx_at,
  ring_char3,
end

lemma disc_char3 {K : Type*} [comm_ring K] (hchar3 : ring_char K = 3)
(f : monic_cubic_poly K)
: f.disc = -f.a^3*f.c + f.a^2*f.b^2 - f.b^3 :=
sub_eq_zero.1 begin
  unfold disc,
  ring_char3,
end

lemma eval_at_mul_cube_of_a_char3 {K : Type*} [comm_ring K] (hchar3 : ring_char K = 3)
(f : monic_cubic_poly K) (x : K)
: f.eval_at x * f.a^3 = f.eval_dx_at x *
(-x^2*f.a^2 - x*(f.a^2+f.b)*f.a + (f.a^2*f.b-f.b^2)) - f.disc :=
sub_eq_zero.1 begin
  unfold disc eval_at eval_dx_at,
  ring_char3,
end

lemma disc_zero_implies_has_multiple_root
{K : Type*} [field K] (f : monic_cubic_poly K)
(hperfect : ring_char K = 2 ∨ (ring_char K = 3 ∧ f.a = 0) → my_perfect_field K):
f.disc = 0 → f.has_multiple_root :=
begin
  intro hdisc,
  by_cases hchar3 : ring_char K = 3, {
    have hdisc' := disc_char3 hchar3 f,
    by_cases ha : f.a = 0, {
      replace hperfect : nth_power_surjective K 3 := by {
        have h := hperfect (by { right, exact ⟨ hchar3, ha ⟩, }),
        unfold my_perfect_field at h,
        rw hchar3 at h,
        cases h with h h, { contradiction, },
        exact h,
      },
      simp [hdisc', ha, zero_pow] at hdisc,
      cases hperfect (-f.c) with x hx,
      use x,
      simp [is_multiple_root, eval_at,
        eval_dx_at, hx, ha, hdisc],
      ring_char3,
    },
    let x := f.b/f.a,
    have hx' : f.eval_dx_at x = 0 := by {
      rw [eval_dx_at_char3 hchar3 f],
      field_simp [ha],
      ring_char3,
    },
    have hdiv1 := eval_at_mul_cube_of_a_char3 hchar3 f x,
    simp [hx', hdisc, ha] at hdiv1,
    exact ⟨ x, hdiv1, hx' ⟩,
  },
  have h3 := prime_neq_char_is_non_zero K 3 (by norm_num) hchar3, norm_cast at h3,
  have h9 := power_of_prime_neq_char_is_non_zero K 9 3 2 (by norm_num) (by norm_num) hchar3, norm_cast at h9,
  have h27 := power_of_prime_neq_char_is_non_zero K 27 3 3 (by norm_num) (by norm_num) hchar3, norm_cast at h27,
  set! a' : K := -f.a^2*2/9 + 2*f.b/3 with ha', clear_value a',
  set! b' : K := -f.a*f.b/9 + f.c with hb', clear_value b',
  have hdiv1 : ∀ x : K, f.eval_at x = f.eval_dx_at x * (x/3 + f.a/9) + (a' * x + b') := by {
    intro x,
    unfold eval_at
    eval_dx_at,
    rw [ha', hb'],
    field_simp [h3, h9],
    ring,
  },
  by_cases hchar2 : ring_char K = 2, {
    unfold disc at hdisc,
    replace hperfect : nth_power_surjective K 2 := by {
      have h := hperfect (by { left, exact hchar2, }),
      unfold my_perfect_field at h,
      rw hchar2 at h,
      cases h with h h, { contradiction, },
      exact h,
    },
    replace hb' : b' = f.c - f.a*f.b := by {
      rw hb',
      ring_char2,
    },
    ring_char2 at ha',
    ring_char2 at hdisc,
    replace hb' := calc (b')^2 = f.a^2*f.b^2 - 2*f.a*f.b*f.c + 2*f.c^2 - f.c^2 : by { rw hb', ring, }
    ... = f.a^2*f.b^2 - f.c^2 : by { ring_char2, }
    ... = 0 : hdisc,
    simp at hb',
    cases hperfect f.b with x hx,
    have hx' : f.eval_dx_at x = 0 := by {
      unfold eval_dx_at,
      rw hx,
      ring_char2,
    },
    replace hdiv1 := hdiv1 x,
    rw [hx', ha', hb'] at hdiv1,
    simp at hdiv1,
    exact ⟨ x, hdiv1, hx' ⟩,
  },
  by_cases ha'zero : a' = 0, {
    have h2 := prime_neq_char_is_non_zero K 2 (by norm_num) hchar2, norm_cast at h2,
    have hb := calc f.b = 2*f.b/3*(3/2) : by { field_simp [h2, h3], ring, }
    ... = (-f.a^2*2/9 + 2*f.b/3 + f.a^2*2/9)*(3/2) : by { congr, field_simp [h3, h9], ring, }
    ... = f.a^2/3 : by { rw [← ha', ha'zero], field_simp [h2, h3, h9], ring, },
    have hdisc' : f.disc = -27*(b')^2 := by {
      unfold disc,
      rw [hb', hb],
      field_simp [h3, h9],
      ring,
    },
    replace hb' : b' = 0 := by {
      rw hdisc at hdisc',
      simp [h27] at hdisc',
      exact hdisc',
    },
    let x := -f.a/3,
    have hx' : f.eval_dx_at x = 0 := by {
      unfold eval_dx_at,
      rw hb,
      field_simp [h3],
      ring,
    },
    replace hdiv1 := hdiv1 x,
    rw [hx', ha'zero, hb'] at hdiv1,
    simp at hdiv1,
    exact ⟨ x, hdiv1, hx' ⟩,
  },
  let x := -b'/a',
  have haxb : a' * x + b' = 0 := by {
    field_simp [ha'zero],
    ring,
  },
  have hx' : f.eval_dx_at x = 0 := by {
    unfold eval_dx_at,
    field_simp [ha'zero],
    transitivity (3 * b' ^ 2 + -(2 * f.a * b' * a') + f.b * a' ^ 2) * a',
    { simp [add_mul], ring, },
    simp [ha'zero],
    rw [ha', hb'],
    field_simp [h3, h9],
    transitivity -1594323*f.disc,
    { unfold disc, ring, },
    rw hdisc, ring,
  },
  replace hdiv1 := hdiv1 x,
  rw [haxb, hx'] at hdiv1,
  simp at hdiv1,
  exact ⟨ x, hdiv1, hx' ⟩,
end

end monic_cubic_poly


import .formula ..logic

def dep_0 : atom_dlo → Prop
| (t1 =' t2) := t1 = V' 0 ∨ t2 = V' 0
| (t1 <' t2) := t1 = V' 0 ∨ t2 = V' 0

instance dec_dep_0 : decidable_pred dep_0
| (x <' y) := begin simp [dep_0], apply_instance end
| (x =' y) := begin simp [dep_0], apply_instance end

def solv_0 : atom_dlo → Prop
| (t1 <' t2) := false
| (t1 =' t2) := t1 = V' 0 ∨ t2 = V' 0

instance dec_solv_0 : decidable_pred solv_0
| (t1 <' t2) := decidable.is_false (by simp [solv_0])
| (t1 =' t2) := or.decidable

def term_dlo.decr_idx : term_dlo → term_dlo
| (term_dlo.var m) := term_dlo.var (m-1)
| (term_dlo.cst b) := term_dlo.cst b

def atom_dlo.decr_idx : atom_dlo → atom_dlo
| (atom_dlo.lt t1 t2) := atom_dlo.lt (term_dlo.decr_idx t1) (term_dlo.decr_idx t2)
| (atom_dlo.eq t1 t2) := atom_dlo.eq (term_dlo.decr_idx t1) (term_dlo.decr_idx t2)

def term_dlo.subst_0 : term_dlo → term_dlo → term_dlo
| t (term_dlo.var 0) := term_dlo.decr_idx t
| t (term_dlo.var (k+1)) := term_dlo.var k
| t (term_dlo.cst b) := term_dlo.cst b

def term_dlo.subst_0' : atom_dlo → term_dlo → term_dlo
| ((term_dlo.var 0) =' t) := term_dlo.subst_0 t
| (t =' (term_dlo.var 0)) := term_dlo.subst_0 t
| _ := id

lemma term_dlo.subst_0'_left {t : term_dlo} :
  term_dlo.subst_0' (term_dlo.var 0 =' t) = term_dlo.subst_0 t :=
begin cases t, simp [term_dlo.subst_0'], refl end

lemma term_dlo.subst_0'_right {t : term_dlo} :
  term_dlo.subst_0' (t =' term_dlo.var 0) = term_dlo.subst_0 t :=
begin cases t with k, cases k with k; refl, refl end

def atom_dlo.subst_0 : atom_dlo → atom_dlo → atom_dlo
| a (t1 <' t2) := (term_dlo.subst_0' a t1) <' (term_dlo.subst_0' a t2)
| a (t1 =' t2) := (term_dlo.subst_0' a t1) =' (term_dlo.subst_0' a t2)

def trv : atom_dlo → Prop
| (atom_dlo.lt t1 t2) := false
| (atom_dlo.eq t1 t2) := t1 = t2

instance dec_trv : decidable_pred trv
| (atom_dlo.lt t1 t2) := decidable.is_false (by simp [trv])
| (atom_dlo.eq t1 t2) := begin simp [trv], apply_instance end

lemma of_trv  :
  ∀ {a : atom_dlo}, trv a → ∀ {bs : list rat}, atom_dlo.eval bs a :=
begin
  intros a ha, cases a, exfalso, apply ha, simp [trv] at ha,
  rw ha, intro bs, simp [atom_dlo.eval]
end

lemma term_dlo.eval_decr_idx_eq :
  ∀ (t : term_dlo), ¬(t = term_dlo.var 0) → ∀ (b : rat) (bs : list rat),
    term_dlo.eval bs (term_dlo.decr_idx t) = term_dlo.eval (b :: bs) t :=
begin
  intros t ht b bs, cases t with k b, cases k with k,
  exfalso, apply ht, repeat {simp [term_dlo.decr_idx, term_dlo.eval]}
end

lemma atom_dlo.eval_decr_idx_iff :
  ∀ {a : atom_dlo}, ¬(dep_0 a) → ∀ {b : rat} {bs : list rat},
    atom_dlo.eval bs (atom_dlo.decr_idx a) ↔ atom_dlo.eval (b :: bs) a :=
begin
  intros a ha b bs, cases a with t1 t2 t1 t2;
  {simp [dep_0, not_or_distrib] at ha,
  cases ha with ha1 ha2, simp [atom_dlo.eval, atom_dlo.decr_idx],
  repeat {rw [term_dlo.eval_decr_idx_eq _ _ b bs]}; assumption}
end

lemma of_solv_0 :
  ∀ {a : atom_dlo}, solv_0 a → ∀ {bs : list rat}, ∃ (b : rat), atom_dlo.eval (b :: bs) a :=
begin
  intros a ha rs, cases a; cases ha; subst ha,
  { cases a_a_1 with k r, cases k with k, existsi (0 : rat),
    simp [atom_dlo.eval], existsi (list.inth rs k), simp [atom_dlo.eval,
    term_dlo.eval], existsi r, simp [atom_dlo.eval, term_dlo.eval] },
  { cases a_a with k r, cases k with k, existsi (0 : rat),
    simp [atom_dlo.eval], existsi (list.inth rs k), simp [atom_dlo.eval,
    term_dlo.eval], existsi r, simp [atom_dlo.eval, term_dlo.eval] },
end

lemma trv_subst_0_of_trv :
∀ {a : atom_dlo}, trv a → ∀ (eq : atom_dlo), trv (atom_dlo.subst_0 eq a) :=
begin
  intros a ha, cases a; cases ha,
  intro eq, simp [atom_dlo.subst_0, trv]
end

lemma eval_decr_idx_eq_of_ne_var_0 {t : term_dlo} :
  t ≠ term_dlo.var 0 → ∀ b bs, term_dlo.eval bs (term_dlo.decr_idx t) = term_dlo.eval (b::bs) t :=
begin
  intros h b bs, cases t with k b,
  cases k with k, exfalso, apply h, refl,
  repeat {simp [term_dlo.decr_idx, term_dlo.eval]}
end

lemma eval_subst_0_eq
  {b : rat} {bs : list rat} {t1 t2 : term_dlo}
  (h2 : t2 ≠ term_dlo.var 0) (h3 : b = term_dlo.eval (b :: bs) t2) :
  term_dlo.eval bs (term_dlo.subst_0 t2 t1) = term_dlo.eval (b :: bs) t1 :=
begin
  cases t1 with k b1;
  [
    {
      cases k with k;
      [
        {simp [term_dlo.subst_0, term_dlo.eval], rw h3,
          apply eval_decr_idx_eq_of_ne_var_0 h2},
        {simp [term_dlo.subst_0, term_dlo.eval]}
      ]
    },
    {simp [term_dlo.subst_0, term_dlo.eval]}
  ]
end

lemma eval_subst_0'_eq
  {a1 : atom_dlo} {h1 : solv_0 a1} {h2 : ¬trv a1}
  {b : rat} {bs : list rat} {h3 : atom_dlo.eval (b :: bs) a1} {t1 t2 : term_dlo} :
  term_dlo.eval bs (term_dlo.subst_0' a1 t1) = term_dlo.eval (b :: bs) t1 :=
begin
  cases a1; cases h1; subst h1;
  [
    {rw term_dlo.subst_0'_left,
     apply eval_subst_0_eq (ne.symm h2) h3},
    {rw term_dlo.subst_0'_right,
     apply eval_subst_0_eq h2 (eq.symm h3)}
  ]
end

lemma eval_subst_0_iff :
 ∀ {a1 : atom_dlo}, solv_0 a1 → ¬ trv a1 →
   ∀ {b} {bs : list rat}, atom_dlo.eval (b :: bs) a1
   → ∀ {a2 : atom_dlo}, atom_dlo.eval bs (atom_dlo.subst_0 a1 a2) ↔ atom_dlo.eval (b :: bs) a2 :=
begin
  intros a1 h1 h2 b bs h3 a2,
  cases a2 with t1 t2 t1 t2;
  simp [atom_dlo.eval];
  [
    {apply lt_iff_lt_of_eq_of_eq,
     repeat {apply eval_subst_0'_eq; assumption}},
    {apply eq_iff_eq_of_eq_of_eq,
     repeat {apply eval_subst_0'_eq; assumption}}
  ]
end

#exit

def atom_dlo.decr_idx : atom_dlo → atom_dlo
| (atom_dlo.lt t1 t2) := atom_dlo.lt (term_dlo.decr_idx t1) (term_dlo.decr_idx t2)
| (atom_dlo.eq t1 t2) := atom_dlo.eq (term_dlo.decr_idx t1) (term_dlo.decr_idx t2)

def term_dlo.subst_0 : term_dlo → term_dlo → term_dlo
| t (term_dlo.var 0) := term_dlo.decr_idx t
| t (term_dlo.var (k+1)) := term_dlo.var k
| t (term_dlo.cst b) := term_dlo.cst b

def term_dlo.subst_0' : atom_dlo → term_dlo → term_dlo
| ((term_dlo.var 0) =' t) := term_dlo.subst_0 t
| (t =' (term_dlo.var 0)) := term_dlo.subst_0 t
| _ := id

lemma term_dlo.subst_0'_left {t : term_dlo} :
  term_dlo.subst_0' (term_dlo.var 0 =' t) = term_dlo.subst_0 t :=
begin cases t, simp [term_dlo.subst_0'], refl end

lemma term_dlo.subst_0'_right {t : term_dlo} :
  term_dlo.subst_0' (t =' term_dlo.var 0) = term_dlo.subst_0 t :=
begin cases t with k, cases k with k; refl, refl end

def atom_dlo.subst_0 : atom_dlo → atom_dlo → atom_dlo
| a (t1 <' t2) := (term_dlo.subst_0' a t1) <' (term_dlo.subst_0' a t2)
| a (t1 =' t2) := (term_dlo.subst_0' a t1) =' (term_dlo.subst_0' a t2)


import fo.normalization

def σ : signature :=
  {
    function := nat,
    relation := nat,
    farity := id,
    rarity := id,
  }

def t₁ : σ.term := signature.term.var (2:nat)

def t₂ : σ.term := signature.term.app (2:nat) (λ i, t₁)

def φ₁ : σ.formula := signature.formula.tt

lemma geq2 : 2 ≥ 2 :=
  by simp

def φ₂ : σ.formula := signature.formula.conj geq2 (λ i, φ₁)

def φ₃ : σ.formula := signature.formula.rel (1:nat) (λ i, t₂)

lemma φ₃_isliteral : ∃ r ts, φ₃ = signature.formula.rel r ts ∨ φ₃ = signature.formula.neg (signature.formula.rel r ts) :=
  begin
    existsi (1:nat),
    existsi (λ i, t₂),
    left,
    refl,
  end
universe u

@[reducible]
def tstyp := nat

def a : tstyp := (3:nat)

def b : tstyp := (4:nat)

def tst : multiset tstyp := {1,3}

def l₁ : σ.literal := subtype.mk φ₃ φ₃_isliteral

variable σ : signature

def c₁ : σ.clause := {l₁}

constant σ : signature

constant ll1 : ss2.literal

noncomputable def cc : ss2.clause := {ll1}