import algebra.homology.homology
import category_theory.limits.shapes.zero_objects
import category_theory.abelian.homology

import for_mathlib.homology_exact

noncomputable theory

open category_theory category_theory.limits

variables {𝓐 : Type*} [category 𝓐] [abelian 𝓐]

section

lemma exact_iff_image_to_kernel'_is_iso {A B C : 𝓐} (f : A ⟶ B) (g : B ⟶ C) (w : f ≫ g = 0) :
  exact f g ↔ is_iso (image_to_kernel' f g w) :=
begin
  refine ⟨λ h, _, λ h, ⟨w, _⟩⟩,
  { suffices : is_iso (image_to_kernel f g w),
    { have hiso : is_iso (image_to_kernel f g w ≫
      (category_theory.limits.kernel_subobject_iso g).hom) := by exactI is_iso.comp_is_iso,
      rw [← image_subobject_iso_image_to_kernel'] at hiso,
      exactI is_iso.of_is_iso_comp_left (image_subobject_iso f).hom _ },
    exact image_to_kernel_is_iso_of_image_eq_kernel _ _
      ((abelian.exact_iff_image_eq_kernel _ _).1 h) },
  { have hiso : is_iso ((category_theory.limits.image_subobject_iso f).hom ≫
      image_to_kernel' f g w) := by exactI is_iso.comp_is_iso,
    rw [image_subobject_iso_image_to_kernel'] at hiso,
    suffices : is_iso (image_to_kernel f g w),
    { haveI := this, apply_instance },
    exactI is_iso.of_is_iso_comp_right _ (kernel_subobject_iso g).hom }

end

lemma homology_is_zero_iff_image_to_kernel'_is_iso {A B C : 𝓐} (f : A ⟶ B) (g : B ⟶ C) (w : f ≫ g = 0) :
  is_zero (homology f g w) ↔ is_iso (image_to_kernel' f g w) :=
⟨λ h, (exact_iff_image_to_kernel'_is_iso _ _ _).1 (exact_of_homology_is_zero h),
  λ h, exact.homology_is_zero _ _ ((exact_iff_image_to_kernel'_is_iso _ _ w).2 h)⟩

end


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

import data.zmod.quotient
import number_theory.class_number.number_field

-- Note: temporary
import algebraic_geometry.EllipticCurve.group
import algebraic_geometry.EllipticCurve.valuation

/-!
# Kummer theory lemmas
-/

noncomputable theory
open_locale classical number_field

universe u

variables {K : Type u} [field K]

----------------------------------------------------------------------------------------------------
/-! ## The subgroup `K(S, n)` -/

section K_S_n

private def with_zero_units {α : Type u} [group α] : (with_zero α)ˣ ≃* α :=
{ to_fun    := λ x, (with_zero.ne_zero_iff_exists.mp x.ne_zero).some,
  inv_fun   := λ x,
  ⟨_, _, mul_inv_cancel $ @with_zero.coe_ne_zero _ x, inv_mul_cancel $ @with_zero.coe_ne_zero _ x⟩,
  left_inv  := λ x,
  by simp only [(with_zero.ne_zero_iff_exists.mp x.ne_zero).some_spec, units.mk_coe],
  right_inv := λ x,
  by { rw [← with_zero.coe_inj,
           (with_zero.ne_zero_iff_exists.mp (_ : (with_zero α)ˣ).ne_zero).some_spec],
       refl },
  map_mul'  := λ x y,
  by { rw [← with_zero.coe_inj, with_zero.coe_mul,
           (with_zero.ne_zero_iff_exists.mp (x * y).ne_zero).some_spec,
           (with_zero.ne_zero_iff_exists.mp x.ne_zero).some_spec,
           (with_zero.ne_zero_iff_exists.mp y.ne_zero).some_spec],
       refl } }

/-- The primes of a number field. -/
@[nolint has_inhabited_instance] def primes (K : Type u) [field K] [number_field K] : Type u :=
maximal_spectrum $ 𝓞 K

variables [number_field K] {S S' : finset $ primes K} {n : ℕ}

/-- The multiplicative valuation of a unit. -/
def val_of_unit (p : primes K) : Kˣ →* multiplicative ℤ :=
with_zero_units.to_monoid_hom.comp $ units.map $ @maximal_spectrum.valuation _ _ _ _ K _ _ _ p

local notation n`⬝`K := (zpow_group_hom n : Kˣ →* Kˣ).range

/-- The multiplicative valuation of a unit modulo `n`-th powers. -/
def val_of_unit_mod (p : primes K) : Kˣ ⧸ (n⬝K) →* multiplicative (zmod n) :=
(int.quotient_zmultiples_nat_equiv_zmod n).to_multiplicative.to_monoid_hom.comp $
  quotient_group.map (n⬝K) (add_subgroup.zmultiples (n : ℤ)).to_subgroup (val_of_unit p) $
begin
  rintro x ⟨y, hy⟩,
  rw [← hy],
  exact ⟨val_of_unit p y, by { rw [zpow_group_hom_apply, map_zpow, int.to_add_zpow], refl }⟩
end

/-- The subgroup `K(S, n) = {b(Kˣ)ⁿ ∈ Kˣ/(Kˣ)ⁿ | ∀ p ∉ S, ord_p(b) ≡ 0 mod n}`. -/
def K_S_n : subgroup (Kˣ ⧸ (n⬝K)) :=
{ carrier  := {b : Kˣ ⧸ (n⬝K) | ∀ p ∉ S, val_of_unit_mod p b = 1},
  one_mem' := λ p _, by rw [map_one],
  mul_mem' := λ _ _ hx hy p hp, by rw [map_mul, hx p hp, hy p hp, one_mul],
  inv_mem' := λ _ hx p hp, by rw [map_inv, hx p hp, one_inv] }

notation K⟮S, n⟯ := @K_S_n K _ _ S n

lemma K_S_n.one_mem : (1 : Kˣ ⧸ (n⬝K)) ∈ K⟮S, n⟯ := K_S_n.one_mem'

lemma K_S_n.mul_mem {x y : Kˣ ⧸ (n⬝K)} (hx : x ∈ K⟮S, n⟯) (hy : y ∈ K⟮S, n⟯) : x * y ∈ K⟮S, n⟯ :=
K_S_n.mul_mem' hx hy

lemma K_S_n.inv_mem {x : Kˣ ⧸ (n⬝K)} (hx : x ∈ K⟮S, n⟯) : x⁻¹ ∈ K⟮S, n⟯ := K_S_n.inv_mem' hx

lemma K_S_n.monotone (hS : S' ⊆ S) : K⟮S', n⟯ ≤ K⟮S, n⟯ := λ _ hb p hp, hb p $ mt (@hS p) hp

/-- The multiplicative valuation on K_S_n. -/
def K_S_n.val : K⟮S, n⟯ →* S → multiplicative (zmod n) :=
{ to_fun   := λ b p, val_of_unit_mod (p : primes K) (b : Kˣ ⧸ (n⬝K)),
  map_one' := funext $ λ p, map_one $ val_of_unit_mod p,
  map_mul' := λ x y, funext $ λ p, map_mul (val_of_unit_mod p) x y }

@[simp] lemma K_S_n.val.map_one : K_S_n.val (1 : K⟮S, n⟯) = 1 := K_S_n.val.map_one'

@[simp] lemma K_S_n.val.map_mul (x y : K⟮S, n⟯) : K_S_n.val (x * y) = K_S_n.val x * K_S_n.val y :=
K_S_n.val.map_mul' x y

lemma K_S_n.val_ker : K_S_n.val.ker = K⟮∅, n⟯.subgroup_of K⟮S, n⟯ :=
begin
  ext ⟨x, hx⟩,
  split,
  { intros hx' p _,
    by_cases hp : p ∈ S,
    { exact congr_fun hx' ⟨p, hp⟩ },
    { exact hx p hp } },
  { exact λ hx', funext $ λ p, hx' p $ finset.not_mem_empty p }
end

/-- A group homomorphism `K(∅, n) → Cl(K)`. -/
def K_0_n.to_class : K⟮∅, n⟯ →* class_group (𝓞 K) K := sorry

/-- A group homomorphism `𝓞ˣ → K(S, n)`. -/
def K_0_n.from_unit : (𝓞 K)ˣ →* K⟮∅, n⟯ := sorry

lemma K_0_n.to_class_ker : (K_0_n.to_class.ker : subgroup K⟮∅, n⟯) = K_0_n.from_unit.range := sorry

local notation n`⬝𝓞`K := (zpow_group_hom n : (𝓞 K)ˣ →* (𝓞 K)ˣ).range

lemma K_0_n.from_unit_ker : (@K_0_n.from_unit K _ _ n).ker = (n⬝𝓞K) := sorry

-- Input : finite generation of unit group or Dirichlet's unit theorem
/-- `𝓞ˣ/(𝓞ˣ)ⁿ` is finite. -/
instance : fintype $ (𝓞 K)ˣ ⧸ (n⬝𝓞K) := sorry

/-- `K(∅, n)` is finite. -/
def K_0_n.fintype : fintype K⟮∅, n⟯ := group.fintype_of_ker_codom
begin
  rw [K_0_n.to_class_ker],
  apply fintype.of_equiv _ (quotient_group.quotient_ker_equiv_range K_0_n.from_unit).to_equiv,
  rw [K_0_n.from_unit_ker],
  exact has_quotient.quotient.fintype
end $ number_field.ring_of_integers.class_group.fintype K

variables [fact (0 < n)]

/-- `K(S, n)` is finite. -/
instance : fintype K⟮S, n⟯ := group.fintype_of_ker_codom
begin
  rw [@K_S_n.val_ker K _ _ S n],
  exact @fintype.of_equiv _ K⟮∅, n⟯ K_0_n.fintype
    (subgroup.comap_subtype_equiv_of_le $ K_S_n.monotone $ finset.empty_subset S).symm.to_equiv
end $ by exact pi.fintype

notation K⟮S, n⟯`²` := (K⟮S, n⟯.prod K⟮S, n⟯).to_add_subgroup

/-- `K(S, n) × K(S, n)` is finite. -/
instance : fintype K⟮S, n⟯² := fintype.of_equiv _ (subgroup.prod_equiv K⟮S, n⟯ K⟮S, n⟯).symm.to_equiv

end K_S_n

----------------------------------------------------------------------------------------------------


import Basic
import Tangle
import Graph

open Brick

def isLink' : Wall -> Prop
| [] => true
| bs::[] => Bricks.codomain bs = 0
| bs::bs'::w => Bricks.codomain bs = Bricks.domain bs' ∧ isLink' (bs'::w)
def isLink : Wall -> Prop
| [] => true
| bs::w => Bricks.domain bs = 0 ∧ isLink' (bs::w)

def Link := { w : Wall // isLink w }

namespace Link

theorem is_tangle_aux {w : Wall} : isLink' w → isTangle w := by
  induction w with
  | nil => intro; rfl
  | cons bs w h =>
    cases w with
    | nil => intro; rfl
    | cons bs' w =>
      rewrite [isLink', isTangle]
      intro hl
      exact And.intro hl.left (h hl.right)

theorem is_tangle {w : Wall} : isLink w → isTangle w := by
  cases w with
  | nil => intro; rfl
  | cons bs w =>
    rewrite [isLink]
    -- again don't know how to go from (match true | true => a) to just a
    simp
    intro hl
    exact is_tangle_aux hl.right

def tangle (l : Link) : Tangle := ⟨l.val, is_tangle l.property⟩

def link_number (l : Link) : Nat := l.tangle.thread_count

end Link

-- here it is folks
def Knot := { l : Link // l.link_number = 1 }


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.Init.Logic
import Mathlib.Mathport.Rename

/-! Additional congruence lemmas. -/

-- Porting note:
-- the statement of `forall_congr_eq` in Lean 3 is identical to `forall_congr` in Lean 4,
-- so is omitted.
-- theorem forall_congr_eq {a : Sort u} {p q : a → Prop} (h : ∀ x, p x = q x) :
--   (∀ x, p x) = ∀ x, q x :=
-- (forall_congr fun a ↦ (h a))
#align forall_congr_eq forall_congr

theorem imp_congr_eq {a b c d : Prop} (h₁ : a = c) (h₂ : b = d) : (a → b) = (c → d) :=
  propext (imp_congr h₁.to_iff h₂.to_iff)

theorem imp_congr_ctx_eq {a b c d : Prop} (h₁ : a = c) (h₂ : c → b = d) : (a → b) = (c → d) :=
  propext (imp_congr_ctx h₁.to_iff fun hc ↦ (h₂ hc).to_iff)

theorem eq_true_intro {a : Prop} (h : a) : a = True :=
  propext (iff_true_intro h)

theorem eq_false_intro {a : Prop} (h : ¬a) : a = False :=
  propext (iff_false_intro h)

theorem Iff.to_eq {a b : Prop} (h : a ↔ b) : a = b :=
  propext h

theorem iff_eq_eq {a b : Prop} : (a ↔ b) = (a = b) :=
  propext (Iff.intro (fun h ↦ Iff.to_eq h) fun h ↦ h.to_iff)

-- Porting note:
-- `eq_false` and `eq_true` in Lean 3 are not used in mathlib3,
-- and there are already lemmas with these names in Lean 4, so they have not been ported.

-- theorem eq_false {a : Prop} : (a = False) = ¬a :=
--   have : (a ↔ False) = ¬a := propext (iff_false a)
--   Eq.subst (@iff_eq_eq a False) this

-- theorem eq_true {a : Prop} : (a = True) = a :=
--   have : (a ↔ True) = a := propext (iff_true a)
--   Eq.subst (@iff_eq_eq a True) this


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.preimage

/-!
# Locally finite orders

This file defines locally finite orders.

A locally finite order is an order for which all bounded intervals are finite. This allows to make
sense of `Icc`/`Ico`/`Ioc`/`Ioo` as lists, multisets, or finsets.
Further, if the order is bounded above (resp. below), then we can also make sense of the
"unbounded" intervals `Ici`/`Ioi` (resp. `Iic`/`Iio`).

Many theorems about these intervals can be found in `data.finset.locally_finite`.

## Examples

Naturally occurring locally finite orders are `ℕ`, `ℤ`, `ℕ+`, `fin n`, `α × β` the product of two
locally finite orders, `α →₀ β` the finitely supported functions to a locally finite order `β`...

## Main declarations

In a `locally_finite_order`,
* `finset.Icc`: Closed-closed interval as a finset.
* `finset.Ico`: Closed-open interval as a finset.
* `finset.Ioc`: Open-closed interval as a finset.
* `finset.Ioo`: Open-open interval as a finset.
* `multiset.Icc`: Closed-closed interval as a multiset.
* `multiset.Ico`: Closed-open interval as a multiset.
* `multiset.Ioc`: Open-closed interval as a multiset.
* `multiset.Ioo`: Open-open interval as a multiset.

In a `locally_finite_order_top`,
* `finset.Ici`: Closed-infinite interval as a finset.
* `finset.Ioi`: Open-infinite interval as a finset.
* `multiset.Ici`: Closed-infinite interval as a multiset.
* `multiset.Ioi`: Open-infinite interval as a multiset.

In a `locally_finite_order_bot`,
* `finset.Iic`: Infinite-open interval as a finset.
* `finset.Iio`: Infinite-closed interval as a finset.
* `multiset.Iic`: Infinite-open interval as a multiset.
* `multiset.Iio`: Infinite-closed interval as a multiset.

## Instances

A `locally_finite_order` instance can be built
* for a subtype of a locally finite order. See `subtype.locally_finite_order`.
* for the product of two locally finite orders. See `prod.locally_finite_order`.
* for any fintype (but it is noncomputable). See `fintype.to_locally_finite_order`.
* from a definition of `finset.Icc` alone. See `locally_finite_order.of_Icc`.
* by pulling back `locally_finite_order β` through an order embedding `f : α →o β`. See
  `order_embedding.locally_finite_order`.

Instances for concrete types are proved in their respective files:
* `ℕ` is in `data.nat.interval`
* `ℤ` is in `data.int.interval`
* `ℕ+` is in `data.pnat.interval`
* `fin n` is in `data.fin.interval`
* `finset α` is in `data.finset.interval`
* `Σ i, α i` is in `data.sigma.interval`
Along, you will find lemmas about the cardinality of those finite intervals.

## TODO

Provide the `locally_finite_order` instance for `α ×ₗ β` where `locally_finite_order α` and
`fintype β`.

Provide the `locally_finite_order` instance for `α →₀ β` where `β` is locally finite. Provide the
`locally_finite_order` instance for `Π₀ i, β i` where all the `β i` are locally finite.

From `linear_order α`, `no_max_order α`, `locally_finite_order α`, we can also define an
order isomorphism `α ≃ ℕ` or `α ≃ ℤ`, depending on whether we have `order_bot α` or
`no_min_order α` and `nonempty α`. When `order_bot α`, we can match `a : α` to `(Iio a).card`.

We can provide `succ_order α` from `linear_order α` and `locally_finite_order α` using

```lean
lemma exists_min_greater [linear_order α] [locally_finite_order α] {x ub : α} (hx : x < ub) :
  ∃ lub, x < lub ∧ ∀ y, x < y → lub ≤ y :=
begin -- very non golfed
  have h : (finset.Ioc x ub).nonempty := ⟨ub, finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩⟩,
  use finset.min' (finset.Ioc x ub) h,
  split,
  { have := finset.min'_mem _ h,
    simp * at * },
  rintro y hxy,
  obtain hy | hy := le_total y ub,
  apply finset.min'_le,
  simp * at *,
  exact (finset.min'_le _ _ (finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩)).trans hy,
end
```
Note that the converse is not true. Consider `{-2^z | z : ℤ} ∪ {2^z | z : ℤ}`. Any element has a
successor (and actually a predecessor as well), so it is a `succ_order`, but it's not locally finite
as `Icc (-1) 1` is infinite.
-/

open finset function

/-- A locally finite order is an order where bounded intervals are finite. When you don't care too
much about definitional equality, you can use `locally_finite_order.of_Icc` or
`locally_finite_order.of_finite_Icc` to build a locally finite order from just `finset.Icc`. -/
class locally_finite_order (α : Type*) [preorder α] :=
(finset_Icc : α → α → finset α)
(finset_Ico : α → α → finset α)
(finset_Ioc : α → α → finset α)
(finset_Ioo : α → α → finset α)
(finset_mem_Icc : ∀ a b x : α, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b)
(finset_mem_Ico : ∀ a b x : α, x ∈ finset_Ico a b ↔ a ≤ x ∧ x < b)
(finset_mem_Ioc : ∀ a b x : α, x ∈ finset_Ioc a b ↔ a < x ∧ x ≤ b)
(finset_mem_Ioo : ∀ a b x : α, x ∈ finset_Ioo a b ↔ a < x ∧ x < b)

/-- A locally finite order top is an order where all intervals bounded above are finite. This is
slightly weaker than `locally_finite_order` + `order_top` as it allows empty types. -/
class locally_finite_order_top (α : Type*) [preorder α] :=
(finset_Ioi : α → finset α)
(finset_Ici : α → finset α)
(finset_mem_Ici : ∀ a x : α, x ∈ finset_Ici a ↔ a ≤ x)
(finset_mem_Ioi : ∀ a x : α, x ∈ finset_Ioi a ↔ a < x)

/-- A locally finite order bot is an order where all intervals bounded below are finite. This is
slightly weaker than `locally_finite_order` + `order_bot` as it allows empty types. -/
class locally_finite_order_bot (α : Type*) [preorder α] :=
(finset_Iio : α → finset α)
(finset_Iic : α → finset α)
(finset_mem_Iic : ∀ a x : α, x ∈ finset_Iic a ↔ x ≤ a)
(finset_mem_Iio : ∀ a x : α, x ∈ finset_Iio a ↔ x < a)

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order.of_Icc' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, ¬b ≤ x),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a ∧ ¬b ≤ x),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_not_le],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_not_le],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_not_le,
    lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `partial_order` but only
`decidable_eq`. -/
def locally_finite_order.of_Icc (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, x ≠ b),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, a ≠ x),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, a ≠ x ∧ x ≠ b),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_and_ne],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_and_ne],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_and_ne,
    lt_iff_le_and_ne] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order_top.of_Ici' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
  locally_finite_order_top α :=
{ finset_Ici := finset_Ici,
  finset_Ioi := λ a, (finset_Ici a).filter (λ x, ¬x ≤ a),
  finset_mem_Ici := mem_Ici,
  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
only `decidable_eq`. -/
def locally_finite_order_top.of_Ici (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
  locally_finite_order_top α :=
{ finset_Ici := finset_Ici,
  finset_Ioi := λ a, (finset_Ici a).filter (λ x, a ≠ x),
  finset_mem_Ici := mem_Ici,
  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_and_ne] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order_bot.of_Iic' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
  locally_finite_order_bot α :=
{ finset_Iic := finset_Iic,
  finset_Iio := λ a, (finset_Iic a).filter (λ x, ¬a ≤ x),
  finset_mem_Iic := mem_Iic,
  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
only `decidable_eq`. -/
def locally_finite_order_top.of_Iic (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
  locally_finite_order_bot α :=
{ finset_Iic := finset_Iic,
  finset_Iio := λ a, (finset_Iic a).filter (λ x, x ≠ a),
  finset_mem_Iic := mem_Iic,
  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_and_ne] }

variables {α β : Type*}

/-- An empty type is locally finite.

This is not an instance as it would be not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order [preorder α] [is_empty α] :
  locally_finite_order α :=
{ finset_Icc := is_empty_elim,
  finset_Ico := is_empty_elim,
  finset_Ioc := is_empty_elim,
  finset_Ioo := is_empty_elim,
  finset_mem_Icc := is_empty_elim,
  finset_mem_Ico := is_empty_elim,
  finset_mem_Ioc := is_empty_elim,
  finset_mem_Ioo := is_empty_elim }

/-- An empty type is locally finite.

This is not an instance as it would be not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order_top [preorder α] [is_empty α] :
  locally_finite_order_top α :=
{ finset_Ici := is_empty_elim,
  finset_Ioi := is_empty_elim,
  finset_mem_Ici := is_empty_elim,
  finset_mem_Ioi := is_empty_elim }

/-- An empty type is locally finite.

This is not an instance as it would be not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order_bot [preorder α] [is_empty α] :
  locally_finite_order_bot α :=
{ finset_Iic := is_empty_elim,
  finset_Iio := is_empty_elim,
  finset_mem_Iic := is_empty_elim,
  finset_mem_Iio := is_empty_elim }

/-! ### Intervals as finsets -/

namespace finset
variables [preorder α]

section locally_finite_order
variables [locally_finite_order α] {a b x : α}

/-- The finset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a finset.
-/
def Icc (a b : α) : finset α := locally_finite_order.finset_Icc a b

/-- The finset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a finset.
-/
def Ico (a b : α) : finset α := locally_finite_order.finset_Ico a b

/-- The finset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a finset.
-/
def Ioc (a b : α) : finset α := locally_finite_order.finset_Ioc a b

/-- The finset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a finset.
-/
def Ioo (a b : α) : finset α := locally_finite_order.finset_Ioo a b

@[simp] lemma mem_Icc : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
locally_finite_order.finset_mem_Icc a b x

@[simp] lemma mem_Ico : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
locally_finite_order.finset_mem_Ico a b x

@[simp] lemma mem_Ioc : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
locally_finite_order.finset_mem_Ioc a b x

@[simp] lemma mem_Ioo : x ∈ Ioo a b ↔ a < x ∧ x < b :=
locally_finite_order.finset_mem_Ioo a b x

@[simp, norm_cast]
lemma coe_Icc (a b : α) : (Icc a b : set α) = set.Icc a b := set.ext $ λ _, mem_Icc

@[simp, norm_cast]
lemma coe_Ico (a b : α) : (Ico a b : set α) = set.Ico a b := set.ext $ λ _, mem_Ico

@[simp, norm_cast]
lemma coe_Ioc (a b : α) : (Ioc a b : set α) = set.Ioc a b := set.ext $ λ _, mem_Ioc

@[simp, norm_cast]
lemma coe_Ioo (a b : α) : (Ioo a b : set α) = set.Ioo a b := set.ext $ λ _, mem_Ioo

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α] {a x : α}

/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a finset. -/
def Ici (a : α) : finset α := locally_finite_order_top.finset_Ici a

/-- The finset of elements `x` such that `a < x`. Basically `set.Ioi a` as a finset. -/
def Ioi (a : α) : finset α := locally_finite_order_top.finset_Ioi a

@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := locally_finite_order_top.finset_mem_Ici _ _
@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := locally_finite_order_top.finset_mem_Ioi _ _

@[simp, norm_cast]

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α] {a x : α}

/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Iic a` as a finset. -/
def Iic (a : α) : finset α := locally_finite_order_bot.finset_Iic a

/-- The finset of elements `x` such that `a < x`. Basically `set.Iio a` as a finset. -/
def Iio (a : α) : finset α := locally_finite_order_bot.finset_Iio a

@[simp] lemma mem_Iic : x ∈ Iic a ↔ x ≤ a := locally_finite_order_bot.finset_mem_Iic _ _
@[simp] lemma mem_Iio : x ∈ Iio a ↔ x < a := locally_finite_order_bot.finset_mem_Iio _ _

@[simp, norm_cast] lemma coe_Iic (a : α) : (Iic a : set α) = set.Iic a := set.ext $ λ _, mem_Iic
@[simp, norm_cast] lemma coe_Iio (a : α) : (Iio a : set α) = set.Iio a := set.ext $ λ _, mem_Iio

end locally_finite_order_bot

section order_top
variables [locally_finite_order α] [order_top α] {a x : α}

@[priority 100] -- See note [lower priority instance]
instance _root_.locally_finite_order.to_locally_finite_order_top : locally_finite_order_top α :=
{ finset_Ici := λ b, Icc b ⊤,
  finset_Ioi := λ b, Ioc b ⊤,
  finset_mem_Ici := λ a x, by rw [mem_Icc, and_iff_left le_top],
  finset_mem_Ioi := λ a x, by rw [mem_Ioc, and_iff_left le_top] }

lemma Ici_eq_Icc (a : α) : Ici a = Icc a ⊤ := rfl
lemma Ioi_eq_Ioc (a : α) : Ioi a = Ioc a ⊤ := rfl

end order_top

section order_bot
variables [order_bot α] [locally_finite_order α] {b x : α}

@[priority 100] -- See note [lower priority instance]
instance locally_finite_order.to_locally_finite_order_bot : locally_finite_order_bot α :=
{ finset_Iic := Icc ⊥,
  finset_Iio := Ico ⊥,
  finset_mem_Iic := λ a x, by rw [mem_Icc, and_iff_right bot_le],
  finset_mem_Iio := λ a x, by rw [mem_Ico, and_iff_right bot_le] }

lemma Iic_eq_Icc : Iic = Icc (⊥ : α) := rfl
lemma Iio_eq_Ico : Iio = Ico (⊥ : α) := rfl

end order_bot
end finset

/-! ### Intervals as multisets -/

namespace multiset
variables [preorder α]

section locally_finite_order
variables [locally_finite_order α]

/-- The multiset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a
multiset. -/
def Icc (a b : α) : multiset α := (finset.Icc a b).val

/-- The multiset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a
multiset. -/
def Ico (a b : α) : multiset α := (finset.Ico a b).val

/-- The multiset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a
multiset. -/
def Ioc (a b : α) : multiset α := (finset.Ioc a b).val

/-- The multiset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a
multiset. -/
def Ioo (a b : α) : multiset α := (finset.Ioo a b).val

@[simp] lemma mem_Icc {a b x : α} : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
by rw [Icc, ←finset.mem_def, finset.mem_Icc]

@[simp] lemma mem_Ico {a b x : α} : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
by rw [Ico, ←finset.mem_def, finset.mem_Ico]

@[simp] lemma mem_Ioc {a b x : α} : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
by rw [Ioc, ←finset.mem_def, finset.mem_Ioc]

@[simp] lemma mem_Ioo {a b x : α} : x ∈ Ioo a b ↔ a < x ∧ x < b :=
by rw [Ioo, ←finset.mem_def, finset.mem_Ioo]

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α]

/-- The multiset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a multiset. -/
def Ici (a : α) : multiset α := (finset.Ici a).val

/-- The multiset of elements `x` such that `a < x`. Basically `set.Ioi a` as a multiset. -/
def Ioi (a : α) : multiset α := (finset.Ioi a).val

@[simp] lemma mem_Ici {a x : α} : x ∈ Ici a ↔ a ≤ x := by rw [Ici, ←finset.mem_def, finset.mem_Ici]
@[simp] lemma mem_Ioi {a x : α} : x ∈ Ioi a ↔ a < x := by rw [Ioi, ←finset.mem_def, finset.mem_Ioi]

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α]

/-- The multiset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a multiset. -/
def Iic (b : α) : multiset α := (finset.Iic b).val

/-- The multiset of elements `x` such that `x < b`. Basically `set.Iio b` as a multiset. -/
def Iio (b : α) : multiset α := (finset.Iio b).val

@[simp] lemma mem_Iic {b x : α} : x ∈ Iic b ↔ x ≤ b := by rw [Iic, ←finset.mem_def, finset.mem_Iic]
@[simp] lemma mem_Iio {b x : α} : x ∈ Iio b ↔ x < b := by rw [Iio, ←finset.mem_def, finset.mem_Iio]

end locally_finite_order_bot
end multiset

/-! ### Finiteness of `set` intervals -/

namespace set
section preorder
variables [preorder α] [locally_finite_order α] (a b : α)

instance fintype_Icc : fintype (Icc a b) :=
fintype.of_finset (finset.Icc a b) (λ x, by rw [finset.mem_Icc, mem_Icc])

instance fintype_Ico : fintype (Ico a b) :=
fintype.of_finset (finset.Ico a b) (λ x, by rw [finset.mem_Ico, mem_Ico])

instance fintype_Ioc : fintype (Ioc a b) :=
fintype.of_finset (finset.Ioc a b) (λ x, by rw [finset.mem_Ioc, mem_Ioc])

instance fintype_Ioo : fintype (Ioo a b) :=
fintype.of_finset (finset.Ioo a b) (λ x, by rw [finset.mem_Ioo, mem_Ioo])

lemma finite_Icc : (Icc a b).finite := set.finite_of_fintype _
lemma finite_Ico : (Ico a b).finite := set.finite_of_fintype _
lemma finite_Ioc : (Ioc a b).finite := set.finite_of_fintype _
lemma finite_Ioo : (Ioo a b).finite := set.finite_of_fintype _

end preorder

section order_top
variables [preorder α] [locally_finite_order_top α] (a : α)

instance fintype_Ici : fintype (Ici a) :=
fintype.of_finset (finset.Ici a) (λ x, by rw [finset.mem_Ici, mem_Ici])

instance fintype_Ioi : fintype (Ioi a) :=
fintype.of_finset (finset.Ioi a) (λ x, by rw [finset.mem_Ioi, mem_Ioi])

lemma finite_Ici : (Ici a).finite := set.finite_of_fintype _
lemma finite_Ioi : (Ioi a).finite := set.finite_of_fintype _

end order_top

section order_bot
variables [preorder α] [locally_finite_order_bot α] (b : α)

instance fintype_Iic : fintype (Iic b) :=
fintype.of_finset (finset.Iic b) (λ x, by rw [finset.mem_Iic, mem_Iic])

instance fintype_Iio : fintype (Iio b) :=
fintype.of_finset (finset.Iio b) (λ x, by rw [finset.mem_Iio, mem_Iio])

lemma finite_Iic : (Iic b).finite := set.finite_of_fintype _
lemma finite_Iio : (Iio b).finite := set.finite_of_fintype _

end order_bot

end set

/-! ### Instances -/

open finset

section preorder
variables [preorder α] [preorder β]

/-- A noncomputable constructor from the finiteness of all closed intervals. -/
noncomputable def locally_finite_order.of_finite_Icc (h : ∀ a b : α, (set.Icc a b).finite) :
  locally_finite_order α :=
@locally_finite_order.of_Icc' α _ (classical.dec_rel _)
  (λ a b, (h a b).to_finset)
  (λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc])

/-- A fintype is noncomputably a locally finite order. -/
noncomputable def fintype.to_locally_finite_order [fintype α] : locally_finite_order α :=
{ finset_Icc := λ a b, (set.finite.of_fintype (set.Icc a b)).to_finset,
  finset_Ico := λ a b, (set.finite.of_fintype (set.Ico a b)).to_finset,
  finset_Ioc := λ a b, (set.finite.of_fintype (set.Ioc a b)).to_finset,
  finset_Ioo := λ a b, (set.finite.of_fintype (set.Ioo a b)).to_finset,
  finset_mem_Icc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc],
  finset_mem_Ico := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ico],
  finset_mem_Ioc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioc],
  finset_mem_Ioo := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioo] }

instance : subsingleton (locally_finite_order α) :=
subsingleton.intro (λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIcc : h₀_finset_Icc = h₁_finset_Icc,
  { ext a b x, rw [h₀_finset_mem_Icc, h₁_finset_mem_Icc] },
  have hIco : h₀_finset_Ico = h₁_finset_Ico,
  { ext a b x, rw [h₀_finset_mem_Ico, h₁_finset_mem_Ico] },
  have hIoc : h₀_finset_Ioc = h₁_finset_Ioc,
  { ext a b x, rw [h₀_finset_mem_Ioc, h₁_finset_mem_Ioc] },
  have hIoo : h₀_finset_Ioo = h₁_finset_Ioo,
  { ext a b x, rw [h₀_finset_mem_Ioo, h₁_finset_mem_Ioo] },
  simp_rw [hIcc, hIco, hIoc, hIoo],
end)

instance : subsingleton (locally_finite_order_top α) :=
subsingleton.intro $ λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIci : h₀_finset_Ici = h₁_finset_Ici,
  { ext a b x, rw [h₀_finset_mem_Ici, h₁_finset_mem_Ici] },
  have hIoi : h₀_finset_Ioi = h₁_finset_Ioi,
  { ext a b x, rw [h₀_finset_mem_Ioi, h₁_finset_mem_Ioi] },
  simp_rw [hIci, hIoi],
end

instance : subsingleton (locally_finite_order_bot α) :=
subsingleton.intro $ λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIic : h₀_finset_Iic = h₁_finset_Iic,
  { ext a b x, rw [h₀_finset_mem_Iic, h₁_finset_mem_Iic] },
  have hIio : h₀_finset_Iio = h₁_finset_Iio,
  { ext a b x, rw [h₀_finset_mem_Iio, h₁_finset_mem_Iio] },
  simp_rw [hIic, hIio],
end

-- Should this be called `locally_finite_order.lift`?
/-- Given an order embedding `α ↪o β`, pulls back the `locally_finite_order` on `β` to `α`. -/
protected noncomputable def order_embedding.locally_finite_order [locally_finite_order β]
  (f : α ↪o β) : locally_finite_order α :=
{ finset_Icc := λ a b, (Icc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ico := λ a b, (Ico (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioc := λ a b, (Ioc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioo := λ a b, (Ioo (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_mem_Icc := λ a b x, by rw [mem_preimage, mem_Icc, f.le_iff_le, f.le_iff_le],
  finset_mem_Ico := λ a b x, by rw [mem_preimage, mem_Ico, f.le_iff_le, f.lt_iff_lt],
  finset_mem_Ioc := λ a b x, by rw [mem_preimage, mem_Ioc, f.lt_iff_lt, f.le_iff_le],
  finset_mem_Ioo := λ a b x, by rw [mem_preimage, mem_Ioo, f.lt_iff_lt, f.lt_iff_lt] }

open order_dual

section locally_finite_order
variables [locally_finite_order α] (a b : α)

/-- Note we define `Icc (to_dual a) (to_dual b)` as `Icc α _ _ b a` (which has type `finset α` not
`finset αᵒᵈ`!) instead of `(Icc b a).map to_dual.to_embedding` as this means the
following is defeq:
```
lemma this : (Icc (to_dual (to_dual a)) (to_dual (to_dual b)) : _) = (Icc a b : _) := rfl
```
-/
instance : locally_finite_order αᵒᵈ :=
{ finset_Icc := λ a b, @Icc α _ _ (of_dual b) (of_dual a),
  finset_Ico := λ a b, @Ioc α _ _ (of_dual b) (of_dual a),
  finset_Ioc := λ a b, @Ico α _ _ (of_dual b) (of_dual a),
  finset_Ioo := λ a b, @Ioo α _ _ (of_dual b) (of_dual a),
  finset_mem_Icc := λ a b x, mem_Icc.trans (and_comm _ _),
  finset_mem_Ico := λ a b x, mem_Ioc.trans (and_comm _ _),
  finset_mem_Ioc := λ a b x, mem_Ico.trans (and_comm _ _),
  finset_mem_Ioo := λ a b x, mem_Ioo.trans (and_comm _ _) }

lemma Icc_to_dual : Icc (to_dual a) (to_dual b) = (Icc b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }

lemma Ico_to_dual : Ico (to_dual a) (to_dual b) = (Ioc b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }

lemma Ioc_to_dual : Ioc (to_dual a) (to_dual b) = (Ico b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }

lemma Ioo_to_dual : Ioo (to_dual a) (to_dual b) = (Ioo b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }

lemma Icc_of_dual (a b : αᵒᵈ) : Icc (of_dual a) (of_dual b) = (Icc b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }

lemma Ico_of_dual (a b : αᵒᵈ) : Ico (of_dual a) (of_dual b) = (Ioc b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }

lemma Ioc_of_dual (a b : αᵒᵈ) : Ioc (of_dual a) (of_dual b) = (Ico b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }

lemma Ioo_of_dual (a b : αᵒᵈ) : Ioo (of_dual a) (of_dual b) = (Ioo b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α]

/-- Note we define `Iic (to_dual a)` as `Ici a` (which has type `finset α` not `finset αᵒᵈ`!)
instead of `(Ici a).map to_dual.to_embedding` as this means the following is defeq:
```
lemma this : (Iic (to_dual (to_dual a)) : _) = (Iic a : _) := rfl
```
-/
instance : locally_finite_order_bot αᵒᵈ :=
{ finset_Iic := λ a, @Ici α _ _ (of_dual a),
  finset_Iio := λ a, @Ioi α _ _ (of_dual a),
  finset_mem_Iic := λ a x, mem_Ici,
  finset_mem_Iio := λ a x, mem_Ioi }

lemma Iic_to_dual (a : α) : Iic (to_dual a) = (Ici a).map to_dual.to_embedding := map_refl.symm
lemma Iio_to_dual (a : α) : Iio (to_dual a) = (Ioi a).map to_dual.to_embedding := map_refl.symm
lemma Ici_of_dual (a : αᵒᵈ) : Ici (of_dual a) = (Iic a).map of_dual.to_embedding := map_refl.symm
lemma Ioi_of_dual (a : αᵒᵈ) : Ioi (of_dual a) = (Iio a).map of_dual.to_embedding := map_refl.symm

end locally_finite_order_top

section locally_finite_order_top
variables [locally_finite_order_bot α]

/-- Note we define `Ici (to_dual a)` as `Iic a` (which has type `finset α` not `finset αᵒᵈ`!)
instead of `(Iic a).map to_dual.to_embedding` as this means the following is defeq:
```
lemma this : (Ici (to_dual (to_dual a)) : _) = (Ici a : _) := rfl
```
-/
instance : locally_finite_order_top αᵒᵈ :=
{ finset_Ici := λ a, @Iic α _ _ (of_dual a),
  finset_Ioi := λ a, @Iio α _ _ (of_dual a),
  finset_mem_Ici := λ a x, mem_Iic,
  finset_mem_Ioi := λ a x, mem_Iio }

lemma Ici_to_dual (a : α) : Ici (to_dual a) = (Iic a).map to_dual.to_embedding := map_refl.symm
lemma Ioi_to_dual (a : α) : Ioi (to_dual a) = (Iio a).map to_dual.to_embedding := map_refl.symm
lemma Iic_of_dual (a : αᵒᵈ) : Iic (of_dual a) = (Ici a).map of_dual.to_embedding := map_refl.symm
lemma Iio_of_dual (a : αᵒᵈ) : Iio (of_dual a) = (Ioi a).map of_dual.to_embedding := map_refl.symm

end locally_finite_order_top

instance [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order (α × β) :=
locally_finite_order.of_Icc' (α × β)
  (λ a b, (Icc a.fst b.fst).product (Icc a.snd b.snd))
  (λ a b x, by { rw [mem_product, mem_Icc, mem_Icc, and_and_and_comm], refl })

instance [locally_finite_order_top α] [locally_finite_order_top β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order_top (α × β) :=
locally_finite_order_top.of_Ici' (α × β)
  (λ a, (Ici a.fst).product (Ici a.snd)) (λ a x, by { rw [mem_product, mem_Ici, mem_Ici], refl })

instance [locally_finite_order_bot α] [locally_finite_order_bot β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order_bot (α × β) :=
locally_finite_order_bot.of_Iic' (α × β)
  (λ a, (Iic a.fst).product (Iic a.snd)) (λ a x, by { rw [mem_product, mem_Iic, mem_Iic], refl })

end preorder

/-!
#### `with_top`, `with_bot`

Adding a `⊤` to a locally finite `order_top` keeps it locally finite.
Adding a `⊥` to a locally finite `order_bot` keeps it locally finite.
-/

namespace with_top
variables (α) [partial_order α] [order_top α] [locally_finite_order α]

local attribute [pattern] coe
local attribute [simp] option.mem_iff

instance : locally_finite_order (with_top α) :=
{ finset_Icc := λ a b, match a, b with
    |       ⊤,       ⊤ := {⊤}
    |       ⊤, (b : α) := ∅
    | (a : α),       ⊤ := insert_none (Ici a)
    | (a : α), (b : α) := (Icc a b).map embedding.coe_option
    end,
  finset_Ico := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ici a).map embedding.coe_option
    | (a : α), (b : α) := (Ico a b).map embedding.coe_option
    end,
  finset_Ioc := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := insert_none (Ioi a)
    | (a : α), (b : α) := (Ioc a b).map embedding.coe_option
    end,
  finset_Ioo := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ioi a).map embedding.coe_option
    | (a : α), (b : α) := (Ioo a b).map embedding.coe_option
    end,
  finset_mem_Icc := λ a b x, match a, b, x with
    |       ⊤,       ⊤,       x := mem_singleton.trans (le_antisymm_iff.trans $ and_comm _ _)
    |       ⊤, (b : α),       x := iff_of_false (not_mem_empty _)
                                     (λ h, (h.1.trans h.2).not_lt $ coe_lt_top _)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    end,
  finset_mem_Ico := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_lt h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioc := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_le h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_3, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_3]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioo := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_4, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe, coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_4]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe]
    end }

variables (a b : α)

lemma Icc_coe_top : Icc (a : with_top α) ⊤ = insert_none (Ici a) := rfl
lemma Icc_coe_coe : Icc (a : with_top α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_coe_top : Ico (a : with_top α) ⊤ = (Ici a).map embedding.coe_option := rfl
lemma Ico_coe_coe : Ico (a : with_top α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_coe_top : Ioc (a : with_top α) ⊤ = insert_none (Ioi a) := rfl
lemma Ioc_coe_coe : Ioc (a : with_top α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_coe_top : Ioo (a : with_top α) ⊤ = (Ioi a).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_top α) b = (Ioo a b).map embedding.coe_option := rfl

end with_top

namespace with_bot
variables (α) [partial_order α] [order_bot α] [locally_finite_order α]

instance : locally_finite_order (with_bot α) :=
@order_dual.locally_finite_order (with_top αᵒᵈ) _ _

variables (a b : α)

lemma Icc_bot_coe : Icc (⊥ : with_bot α) b = insert_none (Iic b) := rfl
lemma Icc_coe_coe : Icc (a : with_bot α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_bot_coe : Ico (⊥ : with_bot α) b = insert_none (Iio b) := rfl
lemma Ico_coe_coe : Ico (a : with_bot α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_bot_coe : Ioc (⊥ : with_bot α) b = (Iic b).map embedding.coe_option := rfl
lemma Ioc_coe_coe : Ioc (a : with_bot α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_bot_coe : Ioo (⊥ : with_bot α) b = (Iio b).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_bot α) b = (Ioo a b).map embedding.coe_option := rfl

end with_bot

/-! #### Subtype of a locally finite order -/

variables [preorder α] (p : α → Prop) [decidable_pred p]

instance [locally_finite_order α] : locally_finite_order (subtype p) :=
{ finset_Icc := λ a b, (Icc (a : α) b).subtype p,
  finset_Ico := λ a b, (Ico (a : α) b).subtype p,
  finset_Ioc := λ a b, (Ioc (a : α) b).subtype p,
  finset_Ioo := λ a b, (Ioo (a : α) b).subtype p,
  finset_mem_Icc := λ a b x, by simp_rw [finset.mem_subtype, mem_Icc, subtype.coe_le_coe],
  finset_mem_Ico := λ a b x, by simp_rw [finset.mem_subtype, mem_Ico, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioc := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioc, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioo := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioo, subtype.coe_lt_coe] }

instance [locally_finite_order_top α] : locally_finite_order_top (subtype p) :=
{ finset_Ici := λ a, (Ici (a : α)).subtype p,
  finset_Ioi := λ a, (Ioi (a : α)).subtype p,
  finset_mem_Ici := λ a x, by simp_rw [finset.mem_subtype, mem_Ici, subtype.coe_le_coe],
  finset_mem_Ioi := λ a x, by simp_rw [finset.mem_subtype, mem_Ioi, subtype.coe_lt_coe] }

instance [locally_finite_order_bot α] : locally_finite_order_bot (subtype p) :=
{ finset_Iic := λ a, (Iic (a : α)).subtype p,
  finset_Iio := λ a, (Iio (a : α)).subtype p,
  finset_mem_Iic := λ a x, by simp_rw [finset.mem_subtype, mem_Iic, subtype.coe_le_coe],
  finset_mem_Iio := λ a x, by simp_rw [finset.mem_subtype, mem_Iio, subtype.coe_lt_coe] }

namespace finset
section locally_finite_order
variables [locally_finite_order α] (a b : subtype p)

lemma subtype_Icc_eq : Icc a b = (Icc (a : α) b).subtype p := rfl
lemma subtype_Ico_eq : Ico a b = (Ico (a : α) b).subtype p := rfl
lemma subtype_Ioc_eq : Ioc a b = (Ioc (a : α) b).subtype p := rfl
lemma subtype_Ioo_eq : Ioo a b = (Ioo (a : α) b).subtype p := rfl

variables (hp : ∀ ⦃a b x⦄, a ≤ x → x ≤ b → p a → p b → p x)
include hp

lemma map_subtype_embedding_Icc : (Icc a b).map (embedding.subtype p) = Icc a b :=
begin
  rw subtype_Icc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Icc at hx,
  exact hp hx.1 hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ico : (Ico a b).map (embedding.subtype p) = Ico a b :=
begin
  rw subtype_Ico_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ico at hx,
  exact hp hx.1 hx.2.le a.prop b.prop,
end

lemma map_subtype_embedding_Ioc : (Ioc a b).map (embedding.subtype p) = Ioc a b :=
begin
  rw subtype_Ioc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioc at hx,
  exact hp hx.1.le hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ioo : (Ioo a b).map (embedding.subtype p) = Ioo a b :=
begin
  rw subtype_Ioo_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioo at hx,
  exact hp hx.1.le hx.2.le a.prop b.prop,
end

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α] (a : subtype p)

lemma subtype_Ici_eq : Ici a = (Ici (a : α)).subtype p := rfl
lemma subtype_Ioi_eq : Ioi a = (Ioi (a : α)).subtype p := rfl

variables (hp : ∀ ⦃a x⦄, a ≤ x → p a → p x)
include hp

lemma map_subtype_embedding_Ici : (Ici a).map (embedding.subtype p) = Ici a :=
by { rw subtype_Ici_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ici.1 hx) a.prop) }

lemma map_subtype_embedding_Ioi : (Ioi a).map (embedding.subtype p) = Ioi a :=
by { rw subtype_Ioi_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ioi.1 hx).le a.prop) }

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α] (a : subtype p)

lemma subtype_Iic_eq : Iic a = (Iic (a : α)).subtype p := rfl
lemma subtype_Iio_eq : Iio a = (Iio (a : α)).subtype p := rfl

variables (hp : ∀ ⦃a x⦄, x ≤ a → p a → p x)
include hp

lemma map_subtype_embedding_Iic : (Iic a).map (embedding.subtype p) = Iic a :=
by { rw subtype_Iic_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iic.1 hx) a.prop) }

lemma map_subtype_embedding_Iio : (Iio a).map (embedding.subtype p) = Iio a :=
by { rw subtype_Iio_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iio.1 hx).le a.prop) }

end locally_finite_order_bot
end finset


import definitions rotations forall_keys tactic.linarith tactic.induction
set_option pp.generalized_field_notation false

universe u

namespace shrink_lemmas
open btree rotation_lemmas forall_keys_lemmas

variables {α : Type u}

lemma shrink_shrink_view (t : btree α) :
  shrink_view t (shrink t) :=
begin
 cases t,
 case empty {
  exact shrink_view.empty,
 },
 case node : l k a r {
  dsimp [shrink],
  cases h : shrink r,
  case none {
    dsimp only [shrink._match_1],
    apply shrink_view.nonempty_empty; assumption,
  },
  case some {
    rcases val with ⟨x, a', sh⟩,
    dsimp only [shrink._match_1],
    by_cases h' : (height l > height sh + 1),
    { simp only [if_pos h'],
      apply shrink_view.nonempty_nonempty₁, try { assumption },
      assumption, simp,
    },
    { simp only [if_neg h'],
      apply shrink_view.nonempty_nonempty₂, try { assumption },
      linarith,
    },
  },
 },
end

/- All the keys in a tree after shrinking are all keys that came from the original tree -/
lemma shrink_keys {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) →
    bound x t = tt ∧ (∀ k', bound k' sh = tt → bound k' t = tt) :=
begin
  intro h₁,
  cases_matching*  (_ ∧ _),
  induction t generalizing x a sh,
  case empty { contradiction, },
  case node : l k v r ihl ihr {
    rw ordered at h₁_left,
    cases_matching* (_ ∧ _),
    cases' shrink_shrink_view (node l k v r),
    case nonempty_empty {
      cases' h₁_right,
      split,
      { simp [bound], },
      { intros k' h₂,
        simp [bound],
        tauto,
      },
     },
    case nonempty_nonempty₁ {
      rw h_2 at h₁_right,
      clear h_2,
      cases' h₁_right,
      specialize ihr h₁_left_right_left h,
      split,
      { cases_matching* (_ ∧ _),
        simp [bound],
        tauto,
      },
      { intros k' h₂,
        rw ← rotate_right_keys at h₂,
        simp [bound] at h₂ ⊢,
        tauto,
      },
    },
    case nonempty_nonempty₂ {
      cases' h₁_right,
      specialize ihr h₁_left_right_left h,
      split,
      { cases_matching* (_ ∧ _),
        simp [bound],
        tauto,
      },
      { intros k' h₂,
        simp [bound] at h₂ ⊢,
        tauto,
      },
    },
  },
end

/- Two auxiliary lemmas for easy usage -/
lemma shrink_keys_aux_1 {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) → bound x t :=
begin
  intro h₁,
  apply and.left (shrink_keys h₁),
end

lemma shrink_keys_aux_2 {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) → (∀ k', bound k' sh → bound k' t) :=
begin
  intro h₁,
  apply and.right (shrink_keys h₁),
end

/-
  After shrinking, if k has a certain relation with a tree, then
  that is preserved with the shrunken tree
-/
lemma forall_shrink {t sh : btree α} {k x : nat} {a : α} {p : nat → nat → Prop} :
  forall_keys p k t ∧ shrink t = some (x, a, sh) → forall_keys p k sh ∧ p k x :=
begin
  intro h₁,
  induction t generalizing x a sh,
  case empty {
    cases_matching* (_ ∧ _),
    contradiction,
  },
  case node : l k v r ihl ihr {
    cases_matching* (_ ∧ _),
    cases' shrink_shrink_view (node l k v r),
    case nonempty_empty {
      cases' h₁_right,
      rw ← forall_keys_char at h₁_left,
      cases_matching* (_ ∧ _),
      split; assumption,
    },
    case nonempty_nonempty₁ {
      rw h_2 at h₁_right,
      clear h_2,
      cases' h₁_right,
      rw ← forall_keys_char at h₁_left,
      cases_matching* (_ ∧ _),
      split,
      { apply forall_rotate_right,
        rw ← forall_keys_char,
        repeat { split }; try { assumption },
        { specialize ihr ⟨ h₁_left_right_right, h ⟩,
          apply and.left ihr,
        },
      },
      { specialize ihr ⟨ h₁_left_right_right, h ⟩,
        apply and.right ihr,
      },
    },
    case nonempty_nonempty₂ {
      cases' h₁_right,
      rw ← forall_keys_char at h₁_left,
      cases_matching* (_ ∧ _),
      split,
      { rw ← forall_keys_char,
        repeat { split }; try { assumption },
        { specialize ihr ⟨ h₁_left_right_right, h ⟩,
          apply and.left ihr,
        },
      },
      { specialize ihr ⟨ h₁_left_right_right, h ⟩,
        apply and.right ihr,
      },
    },
  },
end

/- Auxiliary lemmas for easy usage  -/

lemma forall_shrink_aux_1 {t sh : btree α} {k x : nat} {a : α} {p : nat → nat → Prop} :
  forall_keys p k t ∧ shrink t = some (x, a, sh) → forall_keys p k sh :=
begin
  intro h₁,
  apply and.left (forall_shrink h₁),
end

lemma forall_shrink_aux_2 {t sh : btree α} {k x : nat} {a : α} {p : nat → nat → Prop} :
  forall_keys p k t ∧ shrink t = some (x, a, sh) → p k x :=
begin
  intro h₁,
  apply and.right (forall_shrink h₁),
end

/-
  Shrink preserves order: if a tree is ordered, the resulting of shrinking the tree is also ordered, with
  x being larger than all the keys in the shrunken tree
-/
lemma shrink_ordered {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) → ordered sh ∧ forall_keys gt x sh :=
begin
  intro h₁,
  induction t generalizing x a sh,
  case empty {
    cases_matching* (_ ∧ _),
    contradiction,
  },
  case node : l k v r ihl ihr {
    rw ordered at h₁,
    cases_matching* (_ ∧ _),
    cases' shrink_shrink_view (node l k v r),
    case nonempty_empty {
      cases' h₁_right,
      split; assumption,
    },
    case nonempty_nonempty₁ {
      rw h_2 at h₁_right,
      clear h_2,
      cases' h₁_right,
      specialize ihr ⟨h₁_left_right_left, h⟩,
      cases_matching* (_ ∧ _),
      split,
      { apply rotate_right_ordered,
        repeat { split }; try { assumption },
        { apply forall_shrink_aux_1 (and.intro h₁_left_right_right_right h), }
      },
      { apply forall_rotate_right,
        have h₂ : x_1 > k,
        { have h₃ : bound x_1 r ∧ (∀ k', bound k' sh_1 → bound k' r),
          { apply shrink_keys (and.intro h₁_left_right_left h), },
          cases_matching* (_ ∧ _),
          unfold forall_keys at h₁_left_right_right_right,
          apply h₁_left_right_right_right,
          assumption,
        },
        have h₃ : forall_keys gt x_1 l,
        { apply forall_keys_trans l (>) k; try { assumption },
          { apply trans, },
        },
        rw ← forall_keys_char,
        repeat { split }; assumption,
      },
    },
    case nonempty_nonempty₂ {
      cases' h₁_right,
      specialize ihr ⟨h₁_left_right_left, h⟩,
      cases_matching* (_ ∧ _),
      split,
      { rw ordered,
        repeat { split }; try { assumption },
        { apply forall_shrink_aux_1 (and.intro h₁_left_right_right_right h), },
      },
      { have h₂ : x_1 > k,
        { have h₃ : bound x_1 r ∧ (∀ k', bound k' sh_1 → bound k' r),
          { apply shrink_keys (and.intro h₁_left_right_left h), },
          cases_matching* (_ ∧ _),
          unfold forall_keys at h₁_left_right_right_right,
          apply h₁_left_right_right_right,
          assumption,
        },
        have h₃ : forall_keys gt x_1 l,
        { apply forall_keys_trans l (>) k; try { assumption },
          { apply trans, },
        },
        rw ← forall_keys_char,
        repeat { split }; assumption,
      },
    },
  },
end

/- Auxiliary lemmas for easy usage -/
lemma shrink_ordered_aux_1 {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) → ordered sh :=
begin
  intro h₁,
  apply and.left (shrink_ordered h₁),
end

lemma shrink_ordered_aux_2 {t sh : btree α} {x : nat} {a : α} :
  ordered t ∧ shrink t = some (x, a, sh) → forall_keys (>) x sh :=
begin
  intro h₁,
  apply and.right (shrink_ordered h₁),
end

end shrink_lemmas


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow

! This file was ported from Lean 3 source module linear_algebra.sesquilinear_form
! leanprover-community/mathlib commit 87c54600fe3cdc7d32ff5b50873ac724d86aef8d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.LinearMap
import Mathlib.LinearAlgebra.Basis.Bilinear
import Mathlib.LinearAlgebra.BilinearMap
import Mathlib.Algebra.EuclideanDomain.Instances
import Mathlib.RingTheory.NonZeroDivisors

/-!
# Sesquilinear form

This files provides properties about sesquilinear forms. The maps considered are of the form
`M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R`, where `I₁ : R₁ →+* R` and `I₂ : R₂ →+* R` are ring homomorphisms and
`M₁` is a module over `R₁` and `M₂` is a module over `R₂`.
Sesquilinear forms are the special case that `M₁ = M₂`, `R₁ = R₂ = R`, and `I₁ = ring_hom.id R`.
Taking additionally `I₂ = ring_hom.id R`, then one obtains bilinear forms.

These forms are a special case of the bilinear maps defined in `bilinear_map.lean` and all basic
lemmas about construction and elementary calculations are found there.

## Main declarations

* `is_ortho`: states that two vectors are orthogonal with respect to a sesquilinear form
* `is_symm`, `is_alt`: states that a sesquilinear form is symmetric and alternating, respectively
* `orthogonal_bilin`: provides the orthogonal complement with respect to sesquilinear form

## References

* <https://en.wikipedia.org/wiki/Sesquilinear_form#Over_arbitrary_rings>

## Tags

Sesquilinear form,
-/

open BigOperators

variable {R R₁ R₂ R₃ M M₁ M₂ Mₗ₁ Mₗ₁' Mₗ₂ Mₗ₂' K K₁ K₂ V V₁ V₂ n : Type _}

namespace LinearMap

/-! ### Orthogonal vectors -/

section CommRing

-- the `ₗ` subscript variables are for special cases about linear (as opposed to semilinear) maps
variable [CommSemiring R] [CommSemiring R₁] [AddCommMonoid M₁] [Module R₁ M₁] [CommSemiring R₂]
  [AddCommMonoid M₂] [Module R₂ M₂] {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- The proposition that two elements of a sesquilinear form space are orthogonal -/
def IsOrtho (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x : M₁) (y : M₂) : Prop :=
  B x y = 0
#align linear_map.is_ortho LinearMap.IsOrtho

theorem isOrtho_def {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} {x y} : B.IsOrtho x y ↔ B x y = 0 :=
  Iff.rfl
#align linear_map.is_ortho_def LinearMap.isOrtho_def

theorem isOrthoZeroLeft (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : IsOrtho B (0 : M₁) x := by
  dsimp only [IsOrtho]
  rw [map_zero B, zero_apply]
#align linear_map.is_ortho_zero_left LinearMap.isOrthoZeroLeft

theorem isOrthoZeroRight (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : IsOrtho B x (0 : M₂) :=
  map_zero (B x)
#align linear_map.is_ortho_zero_right LinearMap.isOrthoZeroRight

/-- A set of vectors `v` is orthogonal with respect to some bilinear form `B` if and only
if for all `i ≠ j`, `B (v i) (v j) = 0`. For orthogonality between two elements, use
`bilin_form.is_ortho` -/
def IsOrthoᵢ (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) (v : n → M₁) : Prop :=
  Pairwise (B.IsOrtho on v)
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho LinearMap.IsOrthoᵢ

theorem isOrthoᵢ_def {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R} {v : n → M₁} :
    B.IsOrthoᵢ v ↔ ∀ i j : n, i ≠ j → B (v i) (v j) = 0 :=
  Iff.rfl
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho_def LinearMap.isOrthoᵢ_def

theorem isOrthoᵢ_flip (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) {v : n → M₁} :
    B.IsOrthoᵢ v ↔ B.flip.IsOrthoᵢ v := by
  simp_rw [isOrtho_def]
  constructor <;> intro h i j hij
  · change B.flip (v i) (v j) = 0 -- porting note: added this line (TODO understand why?)
    rw [flip_apply]
    rw [isOrthoᵢ_def] at h -- porting note: added this line (TODO verify this is expected)
    exact h j i (Ne.symm hij)
  simp_rw [flip_apply] at h
  rw [isOrthoᵢ_def] at h -- porting note: added this line (TODO verify this is expected)
  exact h j i (Ne.symm hij)
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho_flip LinearMap.isOrthoᵢ_flip

end CommRing

section Field

variable [Field K] [Field K₁] [AddCommGroup V₁] [Module K₁ V₁] [Field K₂] [AddCommGroup V₂]
  [Module K₂ V₂] {I₁ : K₁ →+* K} {I₂ : K₂ →+* K} {I₁' : K₁ →+* K} {J₁ : K →+* K} {J₂ : K →+* K}

-- porting note: manual instances required. Alternative solution is lean4#2074
-- verified using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing
instance : Module K K := Semiring.toModule

-- Alternative to the above:
-- instance : AddCommMonoid (V₂ →ₛₗ[I₂] K) := LinearMap.addCommMonoid
-- instance : Module K (V₂ →ₛₗ[I₂] K) := LinearMap.instModuleLinearMapAddCommMonoid
-- set_option maxHeartbeats 400000

-- todo: this also holds for [comm_ring R] [is_domain R] when J₁ is invertible
theorem ortho_smul_left {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₁} (ha : a ≠ 0) :
    IsOrtho B x y ↔ IsOrtho B (a • x) y := by
  dsimp only [IsOrtho]
  constructor <;> intro H
  · rw [map_smulₛₗ₂, H, smul_zero]
  · rw [map_smulₛₗ₂, smul_eq_zero] at H
    cases' H with H H
    · rw [map_eq_zero I₁] at H
      trivial
    · exact H
#align linear_map.ortho_smul_left LinearMap.ortho_smul_left

-- todo: this also holds for [comm_ring R] [is_domain R] when J₂ is invertible
theorem ortho_smul_right {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₂} {ha : a ≠ 0} :
    IsOrtho B x y ↔ IsOrtho B x (a • y) := by
  dsimp only [IsOrtho]
  constructor <;> intro H
  · rw [map_smulₛₗ, H, smul_zero]
  · rw [map_smulₛₗ, smul_eq_zero] at H
    cases' H with H H
    · simp at H
      exfalso
      exact ha H
    · exact H
#align linear_map.ortho_smul_right LinearMap.ortho_smul_right

/-- A set of orthogonal vectors `v` with respect to some sesquilinear form `B` is linearly
  independent if for all `i`, `B (v i) (v i) ≠ 0`. -/
theorem linearIndependent_of_isOrthoᵢ {B : V₁ →ₛₗ[I₁] V₁ →ₛₗ[I₁'] K} {v : n → V₁}
    (hv₁ : B.IsOrthoᵢ v) (hv₂ : ∀ i, ¬B.IsOrtho (v i) (v i)) : LinearIndependent K₁ v := by
  classical
    rw [linearIndependent_iff']
    intro s w hs i hi
    have : B (s.sum fun i : n ↦ w i • v i) (v i) = 0 := by rw [hs, map_zero, zero_apply]
    have hsum : (s.sum fun j : n ↦ I₁ (w j) * B (v j) (v i)) = I₁ (w i) * B (v i) (v i) :=
      by
      apply Finset.sum_eq_single_of_mem i hi
      intro j _hj hij
      rw [isOrthoᵢ_def.1 hv₁ _ _ hij, mul_zero]
    simp_rw [B.map_sum₂, map_smulₛₗ₂, smul_eq_mul, hsum] at this
    apply (map_eq_zero I₁).mp
    exact eq_zero_of_ne_zero_of_mul_right_eq_zero (hv₂ i) this
set_option linter.uppercaseLean3 false in
#align linear_map.linear_independent_of_is_Ortho LinearMap.linearIndependent_of_isOrthoᵢ

end Field

/-! ### Reflexive bilinear forms -/

section Reflexive

variable [CommSemiring R] [CommSemiring R₁] [AddCommMonoid M₁] [Module R₁ M₁] {I₁ : R₁ →+* R}
  {I₂ : R₁ →+* R} {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is reflexive -/
def IsRefl (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop :=
  ∀ x y, B x y = 0 → B y x = 0
#align linear_map.is_refl LinearMap.IsRefl

namespace IsRefl

variable (H : B.IsRefl)

theorem eq_zero : ∀ {x y}, B x y = 0 → B y x = 0 := fun {x y} ↦ H x y
#align linear_map.is_refl.eq_zero LinearMap.IsRefl.eq_zero

theorem ortho_comm {x y} : IsOrtho B x y ↔ IsOrtho B y x :=
  ⟨eq_zero H, eq_zero H⟩
#align linear_map.is_refl.ortho_comm LinearMap.IsRefl.ortho_comm

theorem domRestrictRefl (H : B.IsRefl) (p : Submodule R₁ M₁) : (B.domRestrict₁₂ p p).IsRefl :=
  fun _ _ ↦ by
  simp_rw [domRestrict₁₂_apply]
  exact H _ _
#align linear_map.is_refl.dom_restrict_refl LinearMap.IsRefl.domRestrictRefl

@[simp]
theorem flip_isRefl_iff : B.flip.IsRefl ↔ B.IsRefl :=
  ⟨fun h x y H ↦ h y x ((B.flip_apply _ _).trans H), fun h x y ↦ h y x⟩
#align linear_map.is_refl.flip_is_refl_iff LinearMap.IsRefl.flip_isRefl_iff

theorem ker_flip_eq_bot (H : B.IsRefl) (h : LinearMap.ker B = ⊥) : LinearMap.ker B.flip = ⊥ := by
  refine' ker_eq_bot'.mpr fun _ hx ↦ ker_eq_bot'.mp h _ _
  ext
  exact H _ _ (LinearMap.congr_fun hx _)
#align linear_map.is_refl.ker_flip_eq_bot LinearMap.IsRefl.ker_flip_eq_bot

theorem ker_eq_bot_iff_ker_flip_eq_bot (H : B.IsRefl) :
    LinearMap.ker B = ⊥ ↔ LinearMap.ker B.flip = ⊥ := by
  refine' ⟨ker_flip_eq_bot H, fun h ↦ _⟩
  exact (congr_arg _ B.flip_flip.symm).trans (ker_flip_eq_bot (flip_isRefl_iff.mpr H) h)
#align linear_map.is_refl.ker_eq_bot_iff_ker_flip_eq_bot LinearMap.IsRefl.ker_eq_bot_iff_ker_flip_eq_bot

end IsRefl

end Reflexive

/-! ### Symmetric bilinear forms -/

section Symmetric

variable [CommSemiring R] [AddCommMonoid M] [Module R M] {I : R →+* R} {B : M →ₛₗ[I] M →ₗ[R] R}

/-- The proposition that a sesquilinear form is symmetric -/
def IsSymm (B : M →ₛₗ[I] M →ₗ[R] R) : Prop :=
  ∀ x y, I (B x y) = B y x
#align linear_map.is_symm LinearMap.IsSymm

namespace IsSymm

protected theorem eq (H : B.IsSymm) (x y) : I (B x y) = B y x :=
  H x y
#align linear_map.is_symm.eq LinearMap.IsSymm.eq

theorem isRefl (H : B.IsSymm) : B.IsRefl := fun x y H1 ↦ by
  rw [← H.eq]
  simp [H1]
#align linear_map.is_symm.is_refl LinearMap.IsSymm.isRefl

theorem ortho_comm (H : B.IsSymm) {x y} : IsOrtho B x y ↔ IsOrtho B y x :=
  H.isRefl.ortho_comm
#align linear_map.is_symm.ortho_comm LinearMap.IsSymm.ortho_comm

theorem domRestrictSymm (H : B.IsSymm) (p : Submodule R M) : (B.domRestrict₁₂ p p).IsSymm :=
  fun _ _ ↦ by
  simp_rw [domRestrict₁₂_apply]
  exact H _ _
#align linear_map.is_symm.dom_restrict_symm LinearMap.IsSymm.domRestrictSymm

end IsSymm

theorem isSymm_iff_eq_flip {B : M →ₗ[R] M →ₗ[R] R} : B.IsSymm ↔ B = B.flip := by
  constructor <;> intro h
  · ext
    rw [← h, flip_apply, RingHom.id_apply]
  intro x y
  conv_lhs => rw [h]
#align linear_map.is_symm_iff_eq_flip LinearMap.isSymm_iff_eq_flip

end Symmetric

/-! ### Alternating bilinear forms -/

section Alternating

-- porting note: alternative lean4#2074 checked using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing

variable [CommRing R] [CommSemiring R₁] [AddCommMonoid M₁] [Module R₁ M₁] {I₁ : R₁ →+* R}
  {I₂ : R₁ →+* R} {I : R₁ →+* R} {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is alternating -/
def IsAlt (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop :=
  ∀ x, B x x = 0
#align linear_map.is_alt LinearMap.IsAlt

namespace IsAlt

variable (H : B.IsAlt)

-- include H

theorem self_eq_zero (x : M₁) : B x x = 0 :=
  H x
#align linear_map.is_alt.self_eq_zero LinearMap.IsAlt.self_eq_zero

theorem neg (x y : M₁) : -B x y = B y x := by
  have H1 : B (y + x) (y + x) = 0 := self_eq_zero H (y + x)
  simp [map_add, self_eq_zero H] at H1
  rw [add_eq_zero_iff_neg_eq] at H1
  exact H1
#align linear_map.is_alt.neg LinearMap.IsAlt.neg

theorem isRefl : B.IsRefl := by
  intro x y h
  rw [← neg H, h, neg_zero]
#align linear_map.is_alt.is_refl LinearMap.IsAlt.isRefl

theorem ortho_comm {x y} : IsOrtho B x y ↔ IsOrtho B y x :=
  H.isRefl.ortho_comm
#align linear_map.is_alt.ortho_comm LinearMap.IsAlt.ortho_comm

end IsAlt

theorem isAlt_iff_eq_neg_flip [NoZeroDivisors R] [CharZero R] {B : M₁ →ₛₗ[I] M₁ →ₛₗ[I] R} :
    B.IsAlt ↔ B = -B.flip := by
  constructor <;> intro h
  · ext
    simp_rw [neg_apply, flip_apply]
    exact (h.neg _ _).symm
  intro x
  let h' := congr_fun₂ h x x
  simp only [neg_apply, flip_apply, ← add_eq_zero_iff_eq_neg] at h'
  exact add_self_eq_zero.mp h'
#align linear_map.is_alt_iff_eq_neg_flip LinearMap.isAlt_iff_eq_neg_flip

end Alternating

end LinearMap

namespace Submodule

/-! ### The orthogonal complement -/

-- porting note: alternative lean4#2074 checked using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing

variable [CommRing R] [CommRing R₁] [AddCommGroup M₁] [Module R₁ M₁] {I₁ : R₁ →+* R} {I₂ : R₁ →+* R}
  {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The orthogonal complement of a submodule `N` with respect to some bilinear form is the set of
elements `x` which are orthogonal to all elements of `N`; i.e., for all `y` in `N`, `B x y = 0`.

Note that for general (neither symmetric nor antisymmetric) bilinear forms this definition has a
chirality; in addition to this "left" orthogonal complement one could define a "right" orthogonal
complement for which, for all `y` in `N`, `B y x = 0`.  This variant definition is not currently
provided in mathlib. -/
def orthogonalBilin (N : Submodule R₁ M₁) (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Submodule R₁ M₁
    where
  carrier := { m | ∀ n ∈ N, B.IsOrtho n m }
  zero_mem' x _ := B.isOrthoZeroRight x
  add_mem' hx hy n hn := by
    rw [LinearMap.IsOrtho, map_add, show B n _ = 0 from hx n hn, show B n _ = 0 from hy n hn,
      zero_add]
  smul_mem' c x hx n hn := by
    rw [LinearMap.IsOrtho, LinearMap.map_smulₛₗ, show B n x = 0 from hx n hn, smul_zero]
#align submodule.orthogonal_bilin Submodule.orthogonalBilin

variable {N L : Submodule R₁ M₁}

@[simp]
theorem mem_orthogonalBilin_iff {m : M₁} : m ∈ N.orthogonalBilin B ↔ ∀ n ∈ N, B.IsOrtho n m :=
  Iff.rfl
#align submodule.mem_orthogonal_bilin_iff Submodule.mem_orthogonalBilin_iff

theorem orthogonalBilin_le (h : N ≤ L) : L.orthogonalBilin B ≤ N.orthogonalBilin B :=
  fun _ hn l hl ↦ hn l (h hl)
#align submodule.orthogonal_bilin_le Submodule.orthogonalBilin_le

theorem le_orthogonalBilin_orthogonalBilin (b : B.IsRefl) :
    N ≤ (N.orthogonalBilin B).orthogonalBilin B := fun n hn _m hm ↦ b _ _ (hm n hn)
#align submodule.le_orthogonal_bilin_orthogonal_bilin Submodule.le_orthogonalBilin_orthogonalBilin

end Submodule

namespace LinearMap

/- porting note: disabling `Ring.toNonAssocRing` solves some of the problems, but not the one with
`Submodule.orthogonalBilin`. That one can be avoided by making Lean find the instance through
unification, but then the proof still has problems, so we opt for `etaExperiment` in a few
declarations below. -/

section Orthogonal

variable [Field K] [AddCommGroup V] [Module K V] [Field K₁] [AddCommGroup V₁] [Module K₁ V₁]
  {J : K →+* K} {J₁ : K₁ →+* K} {J₁' : K₁ →+* K}

set_option synthInstance.etaExperiment true in
-- ↓ This lemma only applies in fields as we require `a * b = 0 → a = 0 ∨ b = 0`
theorem span_singleton_inf_orthogonal_eq_bot (B : V₁ →ₛₗ[J₁] V₁ →ₛₗ[J₁'] K) (x : V₁)
    (hx : ¬B.IsOrtho x x) : (K₁ ∙ x) ⊓ Submodule.orthogonalBilin (K₁ ∙ x) B = ⊥ := by
  rw [← Finset.coe_singleton]
  refine' eq_bot_iff.2 fun y h ↦ _
  rcases mem_span_finset.1 h.1 with ⟨μ, rfl⟩
  replace h := h.2 x (by simp [Submodule.mem_span] : x ∈ Submodule.span K₁ ({x} : Finset V₁))
  rw [Finset.sum_singleton] at h ⊢
  suffices hμzero : μ x = 0
  · rw [hμzero, zero_smul, Submodule.mem_bot]
  rw [isOrtho_def, map_smulₛₗ, smul_eq_mul] at h
  exact Or.elim (zero_eq_mul.mp h.symm)
      (fun y ↦ by simpa using y)
      (fun hfalse ↦ False.elim $ hx hfalse)
#align linear_map.span_singleton_inf_orthogonal_eq_bot LinearMap.span_singleton_inf_orthogonal_eq_bot

set_option synthInstance.etaExperiment true in
-- ↓ This lemma only applies in fields since we use the `mul_eq_zero`
theorem orthogonal_span_singleton_eq_to_lin_ker {B : V →ₗ[K] V →ₛₗ[J] K} (x : V) :
    Submodule.orthogonalBilin (K ∙ x) B = LinearMap.ker (B x) := by
  ext y
  simp_rw [Submodule.mem_orthogonalBilin_iff, LinearMap.mem_ker, Submodule.mem_span_singleton]
  constructor
  · exact fun h ↦ h x ⟨1, one_smul _ _⟩
  · rintro h _ ⟨z, rfl⟩
    rw [isOrtho_def, map_smulₛₗ₂, smul_eq_zero]
    exact Or.intro_right _ h
#align linear_map.orthogonal_span_singleton_eq_to_lin_ker LinearMap.orthogonal_span_singleton_eq_to_lin_ker

-- porting note: workaround for lean4#2074, `etaExperiment` works here
attribute [-instance] Ring.toNonAssocRing

-- todo: Generalize this to sesquilinear maps
theorem span_singleton_sup_orthogonal_eq_top {B : V →ₗ[K] V →ₗ[K] K} {x : V} (hx : ¬B.IsOrtho x x) :
    (K ∙ x) ⊔ @Submodule.orthogonalBilin _ _ _ _ _ _ (_) _ _ (K ∙ x) B = ⊤ := by
  rw [orthogonal_span_singleton_eq_to_lin_ker]
  exact (B x).span_singleton_sup_ker_eq_top hx
#align linear_map.span_singleton_sup_orthogonal_eq_top LinearMap.span_singleton_sup_orthogonal_eq_top

-- todo: Generalize this to sesquilinear maps
/-- Given a bilinear form `B` and some `x` such that `B x x ≠ 0`, the span of the singleton of `x`
  is complement to its orthogonal complement. -/
theorem isCompl_span_singleton_orthogonal {B : V →ₗ[K] V →ₗ[K] K} {x : V} (hx : ¬B.IsOrtho x x) :
    IsCompl (K ∙ x) (@Submodule.orthogonalBilin _ _ _ _ _ _ (_) _ _  (K ∙ x) B) :=
  { Disjoint := disjoint_iff.2 <| span_singleton_inf_orthogonal_eq_bot B x hx
    Codisjoint := codisjoint_iff.2 <| span_singleton_sup_orthogonal_eq_top hx }
#align linear_map.is_compl_span_singleton_orthogonal LinearMap.isCompl_span_singleton_orthogonal

end Orthogonal

/-! ### Adjoint pairs -/

section AdjointPair

section AddCommMonoid

variable [CommSemiring R]

variable [AddCommMonoid M] [Module R M]

variable [AddCommMonoid M₁] [Module R M₁]

variable [AddCommMonoid M₂] [Module R M₂]

variable {I : R →+* R}

variable {B F : M →ₗ[R] M →ₛₗ[I] R} {B' : M₁ →ₗ[R] M₁ →ₛₗ[I] R} {B'' : M₂ →ₗ[R] M₂ →ₛₗ[I] R}

variable {f f' : M →ₗ[R] M₁} {g g' : M₁ →ₗ[R] M}

variable (B B' f g)

/-- 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 IsAdjointPair :=
  ∀ x y, B' (f x) y = B x (g y)
#align linear_map.is_adjoint_pair LinearMap.IsAdjointPair

variable {B B' f g}

theorem isAdjointPair_iff_comp_eq_compl₂ : IsAdjointPair B B' f g ↔ B'.comp f = B.compl₂ g := by
  constructor <;> intro h
  · ext (x y)
    rw [comp_apply, compl₂_apply]
    exact h x y
  · intro _ _
    rw [← compl₂_apply, ← comp_apply, h]
#align linear_map.is_adjoint_pair_iff_comp_eq_compl₂ LinearMap.isAdjointPair_iff_comp_eq_compl₂

theorem isAdjointPairZero : IsAdjointPair B B' 0 0 := fun _ _ ↦ by simp only [zero_apply, map_zero]
#align linear_map.is_adjoint_pair_zero LinearMap.isAdjointPairZero

theorem isAdjointPairId : IsAdjointPair B B 1 1 := fun _ _ ↦ rfl
#align linear_map.is_adjoint_pair_id LinearMap.isAdjointPairId

theorem IsAdjointPair.add (h : IsAdjointPair B B' f g) (h' : IsAdjointPair B B' f' g') :
    IsAdjointPair B B' (f + f') (g + g') := fun x _ ↦ by
  rw [f.add_apply, g.add_apply, B'.map_add₂, (B x).map_add, h, h']
#align linear_map.is_adjoint_pair.add LinearMap.IsAdjointPair.add

theorem IsAdjointPair.comp {f' : M₁ →ₗ[R] M₂} {g' : M₂ →ₗ[R] M₁} (h : IsAdjointPair B B' f g)
    (h' : IsAdjointPair B' B'' f' g') : IsAdjointPair B B'' (f'.comp f) (g.comp g') := fun _ _ ↦ by
  rw [LinearMap.comp_apply, LinearMap.comp_apply, h', h]
#align linear_map.is_adjoint_pair.comp LinearMap.IsAdjointPair.comp

theorem IsAdjointPair.mul {f g f' g' : Module.End R M} (h : IsAdjointPair B B f g)
    (h' : IsAdjointPair B B f' g') : IsAdjointPair B B (f * f') (g' * g) :=
  h'.comp h
#align linear_map.is_adjoint_pair.mul LinearMap.IsAdjointPair.mul

end AddCommMonoid

section AddCommGroup

variable [CommRing R]

variable [AddCommGroup M] [Module R M]

variable [AddCommGroup M₁] [Module R M₁]

-- porting note: manual instances required. Alternative solution is lean4#2074
-- verified using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing

variable {B F : M →ₗ[R] M →ₗ[R] R} {B' : M₁ →ₗ[R] M₁ →ₗ[R] R}

variable {f f' : M →ₗ[R] M₁} {g g' : M₁ →ₗ[R] M}

theorem IsAdjointPair.sub (h : IsAdjointPair B B' f g) (h' : IsAdjointPair B B' f' g') :
    IsAdjointPair B B' (f - f') (g - g') := fun x _ ↦ by
  rw [f.sub_apply, g.sub_apply, B'.map_sub₂, (B x).map_sub, h, h']
#align linear_map.is_adjoint_pair.sub LinearMap.IsAdjointPair.sub

theorem IsAdjointPair.smul (c : R) (h : IsAdjointPair B B' f g) :
    IsAdjointPair B B' (c • f) (c • g) := fun _ _ ↦ by
  simp only [smul_apply, map_smul, smul_eq_mul, h _ _]
#align linear_map.is_adjoint_pair.smul LinearMap.IsAdjointPair.smul

end AddCommGroup

end AdjointPair

/-! ### Self-adjoint pairs-/

section SelfadjointPair

section AddCommMonoid

variable [CommSemiring R]

variable [AddCommMonoid M] [Module R M]

variable {I : R →+* R}

variable (B F : M →ₗ[R] M →ₛₗ[I] R)

/-- 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 IsPairSelfAdjoint (f : Module.End R M) :=
  IsAdjointPair B F f f
#align linear_map.is_pair_self_adjoint LinearMap.IsPairSelfAdjoint

/-- An endomorphism of a module is self-adjoint with respect to a bilinear form if it serves as an
adjoint for itself. -/
protected def IsSelfAdjoint (f : Module.End R M) :=
  IsAdjointPair B B f f
#align linear_map.is_self_adjoint LinearMap.IsSelfAdjoint

end AddCommMonoid

section AddCommGroup

variable [CommRing R]

variable [AddCommGroup M] [Module R M]

-- porting note: manual instances required. Alternative solution is lean4#2074
-- verified using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing

variable [AddCommGroup M₁] [Module R M₁] (B F : M →ₗ[R] M →ₗ[R] R)

/-- The set of pair-self-adjoint endomorphisms are a submodule of the type of all endomorphisms. -/
def isPairSelfAdjointSubmodule : Submodule R (Module.End R M)
    where
  carrier := { f | IsPairSelfAdjoint B F f }
  zero_mem' := isAdjointPairZero
  add_mem' := fun hf hg => hf.add hg
  smul_mem' := @fun c _ h => h.smul c
#align linear_map.is_pair_self_adjoint_submodule LinearMap.isPairSelfAdjointSubmodule

/-- An endomorphism of a module is skew-adjoint with respect to a bilinear form if its negation
serves as an adjoint. -/
def IsSkewAdjoint (f : Module.End R M) :=
  IsAdjointPair B B f (-f)
#align linear_map.is_skew_adjoint LinearMap.IsSkewAdjoint

/-- The set of self-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Jordan subalgebra.) -/
def selfAdjointSubmodule :=
  isPairSelfAdjointSubmodule B B
#align linear_map.self_adjoint_submodule LinearMap.selfAdjointSubmodule

/-- The set of skew-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Lie subalgebra.) -/
def skewAdjointSubmodule :=
  isPairSelfAdjointSubmodule (-B) B
#align linear_map.skew_adjoint_submodule LinearMap.skewAdjointSubmodule

variable {B F}

@[simp]
theorem mem_isPairSelfAdjointSubmodule (f : Module.End R M) :
    f ∈ isPairSelfAdjointSubmodule B F ↔ IsPairSelfAdjoint B F f :=
  Iff.rfl
#align linear_map.mem_is_pair_self_adjoint_submodule LinearMap.mem_isPairSelfAdjointSubmodule

theorem isPairSelfAdjoint_equiv (e : M₁ ≃ₗ[R] M) (f : Module.End R M) :
    IsPairSelfAdjoint B F f ↔
      IsPairSelfAdjoint (B.compl₁₂ ↑e ↑e) (F.compl₁₂ ↑e ↑e) (e.symm.conj f) := by
  have hₗ :
    (F.compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M)).comp (e.symm.conj f) =
      (F.comp f).compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M) := by
    ext
    simp only [LinearEquiv.symm_conj_apply, coe_comp, LinearEquiv.coe_coe, compl₁₂_apply,
      LinearEquiv.apply_symm_apply, Function.comp_apply]
  have hᵣ :
    (B.compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M)).compl₂ (e.symm.conj f) =
      (B.compl₂ f).compl₁₂ (↑e : M₁ →ₗ[R] M) (↑e : M₁ →ₗ[R] M) := by
    ext
    simp only [LinearEquiv.symm_conj_apply, compl₂_apply, coe_comp, LinearEquiv.coe_coe,
      compl₁₂_apply, LinearEquiv.apply_symm_apply, Function.comp_apply]
  have he : Function.Surjective (⇑(↑e : M₁ →ₗ[R] M) : M₁ → M) := e.surjective
  simp_rw [IsPairSelfAdjoint, isAdjointPair_iff_comp_eq_compl₂, hₗ, hᵣ, compl₁₂_inj he he]
#align linear_map.is_pair_self_adjoint_equiv LinearMap.isPairSelfAdjoint_equiv

theorem isSkewAdjoint_iff_neg_self_adjoint (f : Module.End R M) :
    B.IsSkewAdjoint f ↔ IsAdjointPair (-B) B f f :=
  show (∀ x y, B (f x) y = B x ((-f) y)) ↔ ∀ x y, B (f x) y = (-B) x (f y) by simp
#align linear_map.is_skew_adjoint_iff_neg_self_adjoint LinearMap.isSkewAdjoint_iff_neg_self_adjoint

@[simp]
theorem mem_selfAdjointSubmodule (f : Module.End R M) :
    f ∈ B.selfAdjointSubmodule ↔ B.IsSelfAdjoint f :=
  Iff.rfl
#align linear_map.mem_self_adjoint_submodule LinearMap.mem_selfAdjointSubmodule

@[simp]
theorem mem_skewAdjointSubmodule (f : Module.End R M) :
    f ∈ B.skewAdjointSubmodule ↔ B.IsSkewAdjoint f := by
  rw [isSkewAdjoint_iff_neg_self_adjoint]
  exact Iff.rfl
#align linear_map.mem_skew_adjoint_submodule LinearMap.mem_skewAdjointSubmodule

end AddCommGroup

end SelfadjointPair

/-! ### Nondegenerate bilinear forms -/

section Nondegenerate

section CommSemiring

variable [CommSemiring R] [CommSemiring R₁] [AddCommMonoid M₁] [Module R₁ M₁] [CommSemiring R₂]
  [AddCommMonoid M₂] [Module R₂ M₂] {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- A bilinear form is called left-separating if
the only element that is left-orthogonal to every other element is `0`; i.e.,
for every nonzero `x` in `M₁`, there exists `y` in `M₂` with `B x y ≠ 0`.-/
def SeparatingLeft (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
  ∀ x : M₁, (∀ y : M₂, B x y = 0) → x = 0
#align linear_map.separating_left LinearMap.SeparatingLeft

variable (M₁ M₂ I₁ I₂)

/-- In a non-trivial module, zero is not non-degenerate. -/
theorem not_separatingLeft_zero [Nontrivial M₁] : ¬(0 : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R).SeparatingLeft :=
  let ⟨m, hm⟩ := exists_ne (0 : M₁)
  fun h ↦ hm (h m fun _n ↦ rfl)
#align linear_map.not_separating_left_zero LinearMap.not_separatingLeft_zero

variable {M₁ M₂ I₁ I₂}

theorem SeparatingLeft.ne_zero [Nontrivial M₁] {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R}
    (h : B.SeparatingLeft) : B ≠ 0 := fun h0 ↦ not_separatingLeft_zero M₁ M₂ I₁ I₂ <| h0 ▸ h
#align linear_map.separating_left.ne_zero LinearMap.SeparatingLeft.ne_zero

section Linear

variable [AddCommMonoid Mₗ₁] [AddCommMonoid Mₗ₂] [AddCommMonoid Mₗ₁'] [AddCommMonoid Mₗ₂']

variable [Module R Mₗ₁] [Module R Mₗ₂] [Module R Mₗ₁'] [Module R Mₗ₂']

variable {B : Mₗ₁ →ₗ[R] Mₗ₂ →ₗ[R] R} (e₁ : Mₗ₁ ≃ₗ[R] Mₗ₁') (e₂ : Mₗ₂ ≃ₗ[R] Mₗ₂')

theorem SeparatingLeft.congr (h : B.SeparatingLeft) :
    (e₁.arrowCongr (e₂.arrowCongr (LinearEquiv.refl R R)) B).SeparatingLeft := by
  intro x hx
  rw [← e₁.symm.map_eq_zero_iff]
  refine' h (e₁.symm x) fun y ↦ _
  specialize hx (e₂ y)
  simp only [LinearEquiv.arrowCongr_apply, LinearEquiv.symm_apply_apply,
    LinearEquiv.map_eq_zero_iff] at hx
  exact hx
#align linear_map.separating_left.congr LinearMap.SeparatingLeft.congr

@[simp]
theorem separatingLeft_congr_iff :
    (e₁.arrowCongr (e₂.arrowCongr (LinearEquiv.refl R R)) B).SeparatingLeft ↔ B.SeparatingLeft :=
  ⟨fun h ↦ by
    convert h.congr e₁.symm e₂.symm
    ext (x y)
    simp, SeparatingLeft.congr e₁ e₂⟩
#align linear_map.separating_left_congr_iff LinearMap.separatingLeft_congr_iff

end Linear

/-- A bilinear form is called right-separating if
the only element that is right-orthogonal to every other element is `0`; i.e.,
for every nonzero `y` in `M₂`, there exists `x` in `M₁` with `B x y ≠ 0`.-/
def SeparatingRight (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
  ∀ y : M₂, (∀ x : M₁, B x y = 0) → y = 0
#align linear_map.separating_right LinearMap.SeparatingRight

/-- A bilinear form is called non-degenerate if it is left-separating and right-separating. -/
def Nondegenerate (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
  SeparatingLeft B ∧ SeparatingRight B
#align linear_map.nondegenerate LinearMap.Nondegenerate

@[simp]
theorem flip_separatingRight {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.flip.SeparatingRight ↔ B.SeparatingLeft :=
  ⟨fun hB x hy ↦ hB x hy, fun hB x hy ↦ hB x hy⟩
#align linear_map.flip_separating_right LinearMap.flip_separatingRight

@[simp]
theorem flip_separatingLeft {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.flip.SeparatingLeft ↔ SeparatingRight B := by rw [← flip_separatingRight, flip_flip]
#align linear_map.flip_separating_left LinearMap.flip_separatingLeft

@[simp]
theorem flip_nondegenerate {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} : B.flip.Nondegenerate ↔ B.Nondegenerate :=
  Iff.trans and_comm (and_congr flip_separatingRight flip_separatingLeft)
#align linear_map.flip_nondegenerate LinearMap.flip_nondegenerate

theorem separatingLeft_iff_linear_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.SeparatingLeft ↔ ∀ x : M₁, B x = 0 → x = 0 := by
  constructor <;> intro h x hB
  · let h' := h x
    simp only [hB, zero_apply, eq_self_iff_true, forall_const] at h'
    exact h'
  have h' : B x = 0 := by
    ext
    rw [zero_apply]
    exact hB _
  exact h x h'
#align linear_map.separating_left_iff_linear_nontrivial LinearMap.separatingLeft_iff_linear_nontrivial

theorem separatingRight_iff_linear_flip_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.SeparatingRight ↔ ∀ y : M₂, B.flip y = 0 → y = 0 := by
  rw [← flip_separatingLeft, separatingLeft_iff_linear_nontrivial]
#align linear_map.separating_right_iff_linear_flip_nontrivial LinearMap.separatingRight_iff_linear_flip_nontrivial

/-- A bilinear form is left-separating if and only if it has a trivial kernel. -/
theorem separatingLeft_iff_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.SeparatingLeft ↔ LinearMap.ker B = ⊥ :=
  Iff.trans separatingLeft_iff_linear_nontrivial LinearMap.ker_eq_bot'.symm
#align linear_map.separating_left_iff_ker_eq_bot LinearMap.separatingLeft_iff_ker_eq_bot

/-- A bilinear form is right-separating if and only if its flip has a trivial kernel. -/
theorem separatingRight_iff_flip_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
    B.SeparatingRight ↔ LinearMap.ker B.flip = ⊥ := by
  rw [← flip_separatingLeft, separatingLeft_iff_ker_eq_bot]
#align linear_map.separating_right_iff_flip_ker_eq_bot LinearMap.separatingRight_iff_flip_ker_eq_bot

end CommSemiring

section CommRing

variable [CommRing R] [AddCommGroup M] [Module R M] {I I' : R →+* R}

-- porting note: manual instances required. Alternative solution is lean4#2074
-- verified using `set_option synthInstance.etaExperiment true`
attribute [-instance] Ring.toNonAssocRing

theorem IsRefl.nondegenerateOfSeparatingLeft {B : M →ₗ[R] M →ₗ[R] R} (hB : B.IsRefl)
    (hB' : B.SeparatingLeft) : B.Nondegenerate := by
  refine' ⟨hB', _⟩
  rw [separatingRight_iff_flip_ker_eq_bot, hB.ker_eq_bot_iff_ker_flip_eq_bot.mp]
  rwa [← separatingLeft_iff_ker_eq_bot]
#align linear_map.is_refl.nondegenerate_of_separating_left LinearMap.IsRefl.nondegenerateOfSeparatingLeft

theorem IsRefl.nondegenerateOfSeparatingRight {B : M →ₗ[R] M →ₗ[R] R} (hB : B.IsRefl)
    (hB' : B.SeparatingRight) : B.Nondegenerate := by
  refine' ⟨_, hB'⟩
  rw [separatingLeft_iff_ker_eq_bot, hB.ker_eq_bot_iff_ker_flip_eq_bot.mpr]
  rwa [← separatingRight_iff_flip_ker_eq_bot]
#align linear_map.is_refl.nondegenerate_of_separating_right LinearMap.IsRefl.nondegenerateOfSeparatingRight

/-- The restriction of a reflexive bilinear form `B` onto a submodule `W` is
nondegenerate if `W` has trivial intersection with its orthogonal complement,
that is `disjoint W (W.orthogonal_bilin B)`. -/
theorem nondegenerateRestrictOfDisjointOrthogonal {B : M →ₗ[R] M →ₗ[R] R} (hB : B.IsRefl)
    {W : Submodule R M} (hW : Disjoint W (W.orthogonalBilin B)) :
    (B.domRestrict₁₂ W W).Nondegenerate := by
  refine' (hB.domRestrictRefl W).nondegenerateOfSeparatingLeft _
  rintro ⟨x, hx⟩ b₁
  rw [Submodule.mk_eq_zero, ← Submodule.mem_bot R]
  refine' hW.le_bot ⟨hx, fun y hy ↦ _⟩
  specialize b₁ ⟨y, hy⟩
  simp_rw [domRestrict₁₂_apply, Submodule.coe_mk] at b₁
  rw [hB.ortho_comm]
  exact b₁
#align linear_map.nondegenerate_restrict_of_disjoint_orthogonal LinearMap.nondegenerateRestrictOfDisjointOrthogonal

/-- An orthogonal basis with respect to a left-separating bilinear form has no self-orthogonal
elements. -/
theorem IsOrthoᵢ.not_isOrtho_basis_self_of_separatingLeft [Nontrivial R]
    {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : Basis n R M} (h : B.IsOrthoᵢ v) (hB : B.SeparatingLeft)
    (i : n) : ¬B.IsOrtho (v i) (v i) := by
  intro ho
  refine' v.ne_zero i (hB (v i) fun m ↦ _)
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m
  rw [Basis.repr_symm_apply, Finsupp.total_apply, Finsupp.sum, map_sum]
  apply Finset.sum_eq_zero
  rintro j -
  rw [map_smulₛₗ]
  suffices : B (v i) (v j) = 0
  · rw [this, smul_eq_mul, mul_zero]
  obtain rfl | hij := eq_or_ne i j
  · exact ho
  · exact h hij
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho.not_is_ortho_basis_self_of_separating_left LinearMap.IsOrthoᵢ.not_isOrtho_basis_self_of_separatingLeft

/-- An orthogonal basis with respect to a right-separating bilinear form has no self-orthogonal
elements. -/
theorem IsOrthoᵢ.not_isOrtho_basis_self_of_separatingRight [Nontrivial R]
    {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : Basis n R M} (h : B.IsOrthoᵢ v) (hB : B.SeparatingRight)
    (i : n) : ¬B.IsOrtho (v i) (v i) := by
  rw [isOrthoᵢ_flip] at h
  rw [isOrtho_flip]
  exact h.not_isOrtho_basis_self_of_separatingLeft (flip_separatingLeft.mpr hB) i
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho.not_is_ortho_basis_self_of_separating_right LinearMap.IsOrthoᵢ.not_isOrtho_basis_self_of_separatingRight

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is left-separating
if the basis has no elements which are self-orthogonal. -/
theorem IsOrthoᵢ.separatingLeftOfNotIsOrthoBasisSelf [NoZeroDivisors R] {B : M →ₗ[R] M →ₗ[R] R}
    (v : Basis n R M) (hO : B.IsOrthoᵢ v) (h : ∀ i, ¬B.IsOrtho (v i) (v i)) : B.SeparatingLeft :=
  by
  intro m hB
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m
  rw [LinearEquiv.map_eq_zero_iff]
  ext i
  rw [Finsupp.zero_apply]
  specialize hB (v i)
  simp_rw [Basis.repr_symm_apply, Finsupp.total_apply, Finsupp.sum, map_sum₂, map_smulₛₗ₂,
    smul_eq_mul] at hB
  rw [Finset.sum_eq_single i] at hB
  · exact eq_zero_of_ne_zero_of_mul_right_eq_zero (h i) hB
  · intro j _hj hij
    replace hij : B (v j) (v i) = 0 := hO hij
    rw [hij, RingHom.id_apply, mul_zero]
  · intro hi
    replace hi : vi i = 0 := Finsupp.not_mem_support_iff.mp hi
    rw [hi, RingHom.id_apply, zero_mul]
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho.separating_left_of_not_is_ortho_basis_self LinearMap.IsOrthoᵢ.separatingLeftOfNotIsOrthoBasisSelf

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is right-separating
if the basis has no elements which are self-orthogonal. -/
theorem IsOrthoᵢ.separatingRightIffNotIsOrthoBasisSelf [NoZeroDivisors R] {B : M →ₗ[R] M →ₗ[R] R}
    (v : Basis n R M) (hO : B.IsOrthoᵢ v) (h : ∀ i, ¬B.IsOrtho (v i) (v i)) : B.SeparatingRight :=
  by
  rw [isOrthoᵢ_flip] at hO
  rw [← flip_separatingLeft]
  refine' IsOrthoᵢ.separatingLeftOfNotIsOrthoBasisSelf v hO fun i ↦ _
  rw [isOrtho_flip]
  exact h i
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho.separating_right_iff_not_is_ortho_basis_self LinearMap.IsOrthoᵢ.separatingRightIffNotIsOrthoBasisSelf

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is nondegenerate
if the basis has no elements which are self-orthogonal. -/
theorem IsOrthoᵢ.nondegenerateOfNotIsOrthoBasisSelf [NoZeroDivisors R] {B : M →ₗ[R] M →ₗ[R] R}
    (v : Basis n R M) (hO : B.IsOrthoᵢ v) (h : ∀ i, ¬B.IsOrtho (v i) (v i)) : B.Nondegenerate :=
  ⟨IsOrthoᵢ.separatingLeftOfNotIsOrthoBasisSelf v hO h,
    IsOrthoᵢ.separatingRightIffNotIsOrthoBasisSelf v hO h⟩
set_option linter.uppercaseLean3 false in
#align linear_map.is_Ortho.nondegenerate_of_not_is_ortho_basis_self LinearMap.IsOrthoᵢ.nondegenerateOfNotIsOrthoBasisSelf

end CommRing

end Nondegenerate

end LinearMap


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

Some proofs and docs came from `algebra/commute` (c) Neil Strickland
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.units
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Semiconjugate elements of a semigroup

## Main definitions

We say that `x` is semiconjugate to `y` by `a` (`semiconj_by a x y`), if `a * x = y * a`.
In this file we  provide operations on `semiconj_by _ _ _`.

In the names of these operations, we treat `a` as the “left” argument, and both `x` and `y` as
“right” arguments. This way most names in this file agree with the names of the corresponding lemmas
for `commute a b = semiconj_by a b b`. As a side effect, some lemmas have only `_right` version.

Lean does not immediately recognise these terms as equations, so for rewriting we need syntax like
`rw [(h.pow_right 5).eq]` rather than just `rw [h.pow_right 5]`.

This file provides only basic operations (`mul_left`, `mul_right`, `inv_right` etc). Other
operations (`pow_right`, field inverse etc) are in the files that define corresponding notions.
-/

/-- `x` is semiconjugate to `y` by `a`, if `a * x = y * a`. -/
def add_semiconj_by {M : Type u} [Add M] (a : M) (x : M) (y : M) :=
  a + x = y + a

namespace semiconj_by

/-- Equality behind `semiconj_by a x y`; useful for rewriting. -/
protected theorem eq {S : Type u} [Mul S] {a : S} {x : S} {y : S} (h : semiconj_by a x y) : a * x = y * a :=
  h

/-- If `a` semiconjugates `x` to `y` and `x'` to `y'`,
then it semiconjugates `x * x'` to `y * y'`. -/
@[simp] theorem Mathlib.add_semiconj_by.add_right {S : Type u} [add_semigroup S] {a : S} {x : S} {y : S} {x' : S} {y' : S} (h : add_semiconj_by a x y) (h' : add_semiconj_by a x' y') : add_semiconj_by a (x + x') (y + y') := sorry

/-- If both `a` and `b` semiconjugate `x` to `y`, then so does `a * b`. -/
theorem Mathlib.add_semiconj_by.add_left {S : Type u} [add_semigroup S] {a : S} {b : S} {x : S} {y : S} {z : S} (ha : add_semiconj_by a y z) (hb : add_semiconj_by b x y) : add_semiconj_by (a + b) x z := sorry

/-- Any element semiconjugates `1` to `1`. -/
@[simp] theorem one_right {M : Type u} [monoid M] (a : M) : semiconj_by a 1 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (semiconj_by a 1 1)) (equations._eqn_1 a 1 1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = 1 * a)) (mul_one a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a = 1 * a)) (one_mul a))) (Eq.refl a)))

/-- One semiconjugates any element to itself. -/
@[simp] theorem one_left {M : Type u} [monoid M] (x : M) : semiconj_by 1 x x :=
  Eq.symm (one_right x)

/-- If `a` semiconjugates a unit `x` to a unit `y`, then it semiconjugates `x⁻¹` to `y⁻¹`. -/
theorem Mathlib.add_semiconj_by.units_neg_right {M : Type u} [add_monoid M] {a : M} {x : add_units M} {y : add_units M} (h : add_semiconj_by a ↑x ↑y) : add_semiconj_by a ↑(-x) ↑(-y) := sorry

@[simp] theorem units_inv_right_iff {M : Type u} [monoid M] {a : M} {x : units M} {y : units M} : semiconj_by a ↑(x⁻¹) ↑(y⁻¹) ↔ semiconj_by a ↑x ↑y :=
  { mp := units_inv_right, mpr := units_inv_right }

/-- If a unit `a` semiconjugates `x` to `y`, then `a⁻¹` semiconjugates `y` to `x`. -/
theorem Mathlib.add_semiconj_by.units_neg_symm_left {M : Type u} [add_monoid M] {a : add_units M} {x : M} {y : M} (h : add_semiconj_by (↑a) x y) : add_semiconj_by (↑(-a)) y x := sorry

@[simp] theorem Mathlib.add_semiconj_by.units_neg_symm_left_iff {M : Type u} [add_monoid M] {a : add_units M} {x : M} {y : M} : add_semiconj_by (↑(-a)) y x ↔ add_semiconj_by (↑a) x y :=
  { mp := add_semiconj_by.units_neg_symm_left, mpr := add_semiconj_by.units_neg_symm_left }

theorem Mathlib.add_semiconj_by.units_coe {M : Type u} [add_monoid M] {a : add_units M} {x : add_units M} {y : add_units M} (h : add_semiconj_by a x y) : add_semiconj_by ↑a ↑x ↑y :=
  congr_arg add_units.val h

theorem units_of_coe {M : Type u} [monoid M] {a : units M} {x : units M} {y : units M} (h : semiconj_by ↑a ↑x ↑y) : semiconj_by a x y :=
  units.ext h

@[simp] theorem units_coe_iff {M : Type u} [monoid M] {a : units M} {x : units M} {y : units M} : semiconj_by ↑a ↑x ↑y ↔ semiconj_by a x y :=
  { mp := units_of_coe, mpr := units_coe }

@[simp] theorem inv_right_iff {G : Type u} [group G] {a : G} {x : G} {y : G} : semiconj_by a (x⁻¹) (y⁻¹) ↔ semiconj_by a x y :=
  units_inv_right_iff

theorem Mathlib.add_semiconj_by.neg_right {G : Type u} [add_group G] {a : G} {x : G} {y : G} : add_semiconj_by a x y → add_semiconj_by a (-x) (-y) :=
  iff.mpr add_semiconj_by.neg_right_iff

@[simp] theorem inv_symm_left_iff {G : Type u} [group G] {a : G} {x : G} {y : G} : semiconj_by (a⁻¹) y x ↔ semiconj_by a x y :=
  units_inv_symm_left_iff

theorem Mathlib.add_semiconj_by.neg_symm_left {G : Type u} [add_group G] {a : G} {x : G} {y : G} : add_semiconj_by a x y → add_semiconj_by (-a) y x :=
  iff.mpr add_semiconj_by.neg_symm_left_iff

theorem Mathlib.add_semiconj_by.neg_neg_symm {G : Type u} [add_group G] {a : G} {x : G} {y : G} (h : add_semiconj_by a x y) : add_semiconj_by (-a) (-y) (-x) :=
  add_semiconj_by.neg_symm_left (add_semiconj_by.neg_right h)

-- this is not a simp lemma because it can be deduced from other simp lemmas

theorem inv_inv_symm_iff {G : Type u} [group G] {a : G} {x : G} {y : G} : semiconj_by (a⁻¹) (y⁻¹) (x⁻¹) ↔ semiconj_by a x y :=
  iff.trans inv_right_iff inv_symm_left_iff

/-- `a` semiconjugates `x` to `a * x * a⁻¹`. -/
theorem conj_mk {G : Type u} [group G] (a : G) (x : G) : semiconj_by a x (a * x * (a⁻¹)) := sorry

end semiconj_by

/-- `a` semiconjugates `x` to `a * x * a⁻¹`. -/
theorem add_units.mk_semiconj_by {M : Type u} [add_monoid M] (u : add_units M) (x : M) : add_semiconj_by (↑u) x (↑u + x + ↑(-u)) :=
  eq.mpr (id (add_semiconj_by.equations._eqn_1 (↑u) x (↑u + x + ↑(-u))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑u + x = ↑u + x + ↑(-u) + ↑u)) (add_units.neg_add_cancel_right (↑u + x) u)))
      (Eq.refl (↑u + x)))