import analysis.normed.field.basic
import analysis.normed.group.infinite_sum
import data.matrix.basic
import topology.sequences
import algebra.direct_sum.module
import analysis.complex.basic
import analysis.convex.uniform
import analysis.normed_space.bounded_linear_maps
import analysis.normed_space.banach
import linear_algebra.bilinear_form
import linear_algebra.sesquilinear_form

import algebra.module.pi
import topology.support
import analysis.calculus.cont_diff
import order.complete_lattice
import data.real.basic
import analysis.calculus.deriv
import analysis.calculus.iterated_deriv
import algebra.module.pi
import algebra.module.linear_map

noncomputable theory

def smooth (f:ℝ → ℝ) := ∀n:ℕ, cont_diff ℝ n f

def mem_test (f:ℝ → ℝ) : Prop := (has_compact_support f) ∧ (smooth f)

class test_function :=
mk :: (f : ℝ → ℝ) (test : mem_test f )

--def seminorm (f:ℝ→ℝ) [mem_test f] (n:ℕ) := Sup(f '' {x:ℝ | true})

notation f`#`n := iterated_deriv n f

def seminorm (f:ℝ→ℝ) (n:ℕ) := Sup((( abs (f#n)) '' {x:ℝ | true}))

notation `||`f`||_`n := seminorm f n

-- def d_convergence (u:ℕ→(ℝ→ℝ)) [hu : ∀n, mem_test (u n)]  (f:ℝ→ℝ)  [mem_test f] [hf : mem_test f]

--need to restrict to test functions only
def d_convergence (u:ℕ→(ℝ→ℝ)) (f:ℝ→ℝ): Prop :=
(∃ K, is_compact(K) ∧ (∀ n, tsupport (u n) ⊆ K) ∧ (tsupport f ⊆ K) ∧ (∀ n, tsupport (f - u n) ⊆ K) ∧ (∀ε>0,∀N:ℕ, ∃K:ℕ, ∀n, n≥K → (|| f - u n ||_N) ≤ ε))

--need to change to only restict as a functional on test functions maybe use submodule structure

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

-- change this so it depends on the mathlib version of limits and not the limit above
def is_distribution (u: (ℝ→ℝ) → ℝ) : Prop :=
(is_linear_map ℝ u) ∧ (∀ v:ℕ→(ℝ→ℝ), ∀f, d_convergence v f → seq_limit (u∘v) (u f))

lemma zero_mem_test : mem_test (λ x, 0) :=
begin
  let f := (λ (x : ℝ), 0),
  unfold mem_test,
  split,
  unfold has_compact_support,
  have F :  ∅ = function.support (λ (x : ℝ), 0),
    simp,
  unfold tsupport,
  have G : closure(function.support (λ (x : ℝ), 0)) = closure(∅),
    simp,
  simp,
  intro n,
  exact cont_diff_const,
end

lemma add_mem_test {f g : ℝ → ℝ} (hf : mem_test f) (hg : mem_test g) : mem_test (f+g)  :=
begin
  split,
  exact has_compact_support.add hf.1 hg.1,
  intro n,
  exact cont_diff.add (hf.2 n) (hg.2 n),
end

lemma mul_C_inf_right_mem_test  {f g : ℝ → ℝ} (hf : mem_test f) (hg : smooth g) : mem_test (f*g) :=
begin
  split,
  exact has_compact_support.mul_right hf.1,
  intro n,
  exact cont_diff.mul (hf.2 n) (hg n),
end

lemma mul_C_inf_left_mem_test  {f g : ℝ → ℝ} (hf : smooth f) (hg : mem_test g) : mem_test (f*g) :=
begin
  split,
  exact has_compact_support.mul_left hg.1,
  intro n,
  exact cont_diff.mul (hf n) (hg.2 n),
end

lemma mul_mem_test {f g : ℝ → ℝ} (hf : mem_test f) (hg : mem_test g) : mem_test (f*g) :=
begin
  exact mul_C_inf_left_mem_test hf.2 hg,
end

lemma smul_mem_test {c : ℝ} {g : ℝ → ℝ} (hg : mem_test g) : mem_test (c•g) :=
begin
  have : (c•g) = (λ (x : ℝ), c) * g,
    refl,

  rw this,
  have : smooth (λ (x : ℝ), c),
    intro n,
    exact cont_diff_const,

  exact mul_C_inf_left_mem_test this hg,
end

#check is_compact

theorem local_boundedness_principle (u: (ℝ→ℝ) → ℝ) (lin: is_linear_map ℝ u) :
is_distribution u ↔ (∀K:(set ℝ), is_compact(K) → ∃c≥0, ∃n:ℕ, ∀f, tsupport (f) ⊆ K → abs (u f) ≤ c*(finsum (λ k :fin(n+1), ||f||_k)))
:=
begin
  split,
  intros dist_prop,
  by_contra C,
  push_neg at C,
  cases C with K C,
  cases C with K_comp C,

  let G := λ n:ℕ, C n (by simp) n ,

  choose v hv1 hv2 using G,

  have zero := is_linear_map.map_zero dist_prop.1,

  --TODO, show that f n = (v n)/ (u v n) D-converges to 0, but u f n = 1 for every n
  sorry,

  intros bddness,
  split,
  exact lin,

  intros v f conv ε ε_pos,

  rcases conv with ⟨ K, comp_K, comp_v, comp_f, comp_fv, conv⟩,

  specialize bddness K comp_K,

  rcases bddness with ⟨ c, c_pos, N, bddness ⟩,

  have G1 : 0  < ε/((c+1)*(N+1)),
  --fix this
    sorry,

  specialize conv (ε/((c+1)*(N+1))) G1,

  -- choose conv, with j then take max of K_j from 0 to N+1, use max and then conclude by calc

  --specialize bddness (f - (v n)) (comp_fv n),

end

#eval 1+1


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

/-!
# Characterization of `cycle.possible`

TODO
* characterization of possible `usual_engine_cycle` and `usual_pump_cycle`
* sufficient(equivalent) conditions for `cycle.possible` ?
-/

namespace thermodynamics

/-!
### `engine_cycle`
-/

namespace cycle
variables {H : cycle} [engine_cycle H]

lemma abs_every_rsv_if_no_rel (hno_rel : (H.Qrel:ℝ) = 0) {𝓗} (h𝓗supp : 𝓗 ∈ H.𝓠.support) :
  0 < H.𝓠 𝓗 := by {
  by_contradiction this, have := eq_or_lt_of_not_lt this,
  cases this with h𝓗zero h𝓗neg,
  { have := (H.𝓠.mem_support_to_fun 𝓗).elim_left h𝓗supp,
    exact absurd h𝓗zero this.symm, },
  { have : max (- H.𝓠 𝓗) 0 = - H.𝓠 𝓗, from max_eq_left_of_lt (neg_pos_of_neg h𝓗neg),
    have :=
      calc ↑H.Qrel
           = H.𝓠.support.sum (λ 𝓣, max (- H.𝓠 𝓣) 0) : rfl
        ...= - H.𝓠 𝓗 + (H.𝓠.support.erase 𝓗).sum (λ 𝓣, max (- H.𝓠 𝓣) 0) :
              by rw [←finset.add_sum_erase _ _ h𝓗supp, this]
        ...≥ - H.𝓠 𝓗 :
              by simp only [finset.sum_nonneg, ge_iff_le, le_neg_add_iff_add_le, add_right_neg,
                            le_max_iff, le_refl, or_true, implies_true_iff]
        ...> 0 : neg_pos_of_neg h𝓗neg,
    exact absurd hno_rel (ne_of_gt this), }, }
theorem psbl_engine_do_rel (hHpsbl : H.possible) : 0 < H.Qrel := by {
  suffices h : Π n : ℕ, (H.𝓠.support.card = n.succ) → (0 < H.Qrel),
  { exact if hcard : H.𝓠.support.card = 0 then by {
      have : H.𝓠.support = ∅, from finset.card_eq_zero.elim_left hcard,
      have :=
        calc H.𝓦
             = H.𝓠.sum_image : H.𝓦_from_𝓠
          ...= 0             : by rw [finsupp.sum_image, this, finset.sum_empty],
      exact absurd this (ne_of_gt H.engine_do_work), }
    else
      let ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero hcard in
      h k hk },
  assume n, unfreezingI{revert H}, induction n with n ih,
  { assume H engH hHpsbl, haveI := engH, assume hcard,
    exact
    let ⟨𝓣, h𝓣⟩ := finset.card_eq_one.elim_left hcard in
    let H' : one_rsv_cycle 𝓣 :=
      { to_cycle := H,
        one_rsv := h𝓣 } in by {
    have hdo_work : 0 < H'.𝓦 , from H.engine_do_work,
    have hpsbl : H'.possible, from hHpsbl,
    exact absurd hpsbl (kelvin_stmt H' hdo_work), } },
  { assume H engH hHpsbl, haveI := engH, assume hcard,
    by_contradiction hQrel, have hQrel := eq_of_ge_of_not_gt H.Qrel.property hQrel,
    have supp_nonempty := finset.card_pos.elim_left (by { rw hcard, exact nat.succ_pos' }),
    let 𝓒 := H.𝓠.support.min' supp_nonempty,
    let 𝓗 := H.𝓠.support.max' supp_nonempty,
    have 𝓒_supp : 𝓒 ∈ H.𝓠.support, from finset.min'_mem _ _,
    have 𝓗_supp : 𝓗 ∈ H.𝓠.support, from finset.max'_mem _ _,
    have do_abs𝓒 : 0 < H.𝓠 𝓒, from abs_every_rsv_if_no_rel hQrel 𝓒_supp,
    have do_abs𝓗 : 0 < H.𝓠 𝓗, from abs_every_rsv_if_no_rel hQrel 𝓗_supp,
    have 𝓒_lt_𝓗 : 𝓒 < 𝓗, {
      have : 1 < H.𝓠.support.card,
        rw hcard,
        apply nat.succ_lt_succ,
        exact nat.succ_pos',
      exact finset.min'_lt_max'_of_card _ this, },
    exact
    let ⟨eng, heng, hQ⟩ := usual_engine_cycle.exists_psbl_rel 𝓒_lt_𝓗 do_abs𝓒 in
    let H' := H + eng.to_cycle in by {
    haveI : engine_cycle H' :=
      ⟨ calc H'.𝓦
             = H.𝓦 + eng.𝓦 : cycle.𝓦_add
          ...> 0             : add_pos H.engine_do_work eng.do_work ⟩,
    have H'no_𝓒 :=
      calc H'.𝓠 𝓒
           = H.𝓠 𝓒 + eng.𝓠 𝓒    : rfl
        ...= eng.Qrel + eng.𝓠 𝓒 : by rw hQ
        ...= 0                  : by rw [eng.Qrel_one_rsv, add_left_neg],
    have H'do_abs𝓗 :=
      calc H'.𝓠 𝓗
         = H.𝓠 𝓗 + eng.𝓠 𝓗 : rfl
      ...= H.𝓠 𝓗 + eng.Qabs : by rw eng.Qabs_one_rsv
      ...> 0                 : add_pos do_abs𝓗 eng.do_abs,
    have eng_Hsupp : H.𝓠.support ∪ eng.𝓠.support = H.𝓠.support, {
      apply finset.union_eq_left_iff_subset.elim_right,
      rw eng.two_rsv.elim_left,
      apply finset.subset_iff.elim_right,
      simp only [finset.mem_insert, finset.mem_singleton],
      simp only [forall_eq_or_imp, forall_eq],
      exact ⟨𝓗_supp, 𝓒_supp⟩, },
    have lemmaH' : ∀ {𝓣}, (𝓣 ≠ 𝓒) → (𝓣 ∈ H.𝓠.support) → (0 < H'.𝓠 𝓣), {
      assume 𝓣 h𝓣not𝓒 h𝓣_Hsupp,
      exact if h𝓣_𝓗 : 𝓣 = 𝓗 then by {
        rw h𝓣_𝓗, exact H'do_abs𝓗, }
      else by {
        have : eng.𝓠 𝓣 = 0, {
          apply finsupp.not_mem_support_iff.elim_left,
          rw [eng.two_rsv.elim_left, finset.mem_insert, finset.mem_singleton],
          simp only [h𝓣not𝓒, h𝓣_𝓗, or_self, not_false_iff], },
        calc H'.𝓠 𝓣
             = H.𝓠 𝓣 + eng.𝓠 𝓣 : rfl
          ...= H.𝓠 𝓣           : by simp only [this, add_zero]
          ...> 0               : abs_every_rsv_if_no_rel hQrel h𝓣_Hsupp, } },
    have H'supp_erase𝓒 : H'.𝓠.support = H.𝓠.support.erase 𝓒, {
      have : H'.𝓠 = H.𝓠 + eng.𝓠, from rfl, rw this,
      apply finsupp.support_add_exact,
      { simp only [finset.mem_erase, ne.def, and_imp],
        assume 𝓣 h𝓣not𝓒 h𝓣_Hsupp,
        exact ne_of_gt (lemmaH' h𝓣not𝓒 h𝓣_Hsupp), },
      { rw [eng_Hsupp, finset.sdiff_erase 𝓒_supp],
        simp only [finset.mem_singleton, forall_eq],
        exact H'no_𝓒, } },
    have hH'no_rel : H'.Qrel.val = 0, {
      apply finset.sum_eq_zero,
      rw H'supp_erase𝓒,
      simp only [finset.mem_erase, ne.def, max_eq_right_iff, right.neg_nonpos_iff, and_imp],
      assume 𝓣 h𝓣not𝓒 h𝓣_Hsupp,
      exact le_of_lt (lemmaH' h𝓣not𝓒 h𝓣_Hsupp), },
    exact absurd hH'no_rel (ne_of_gt (@ih
      H' _
      (cycle.possible_add hHpsbl heng)
      ( calc H'.𝓠.support.card
           = (H.𝓠.support.erase 𝓒).card : by rw H'supp_erase𝓒
        ...= H.𝓠.support.card - 1       : finset.card_erase_of_mem 𝓒_supp
        ...= n.succ                     : by rw [hcard, nat.succ_sub_one] ) ) ), } } }
theorem psbl_engine_eff_lt_one (hHpsbl : H.possible) : H.eff < 1 := by {
  rw H.eff_from_Qabs_Qrel,
  have : (0:ℝ) < H.Qrel / H.Qabs, from div_pos (psbl_engine_do_rel hHpsbl) H.engine_do_abs,
  simp only [this, sub_lt_self_iff], }
--

end cycle

end thermodynamics


import topology.sheaves.stalks
import category_theory.category.galois_connection

section inducing

open topological_space category_theory

universe u

variables {X Y : Top.{u}} {f : X ⟶ Y}

/-- Given an inducing map `X ⟶ Y` and some `U : opens X`, this is the union of all open sets
whose preimage is `U`. This is right adjoint to `opens.map`. -/
@[nolint unused_arguments]
def inducing.functor_obj {X Y : Top} {f : X ⟶ Y} (hf : inducing f) (U : opens X) : opens Y :=
Sup { s : opens Y | (topological_space.opens.map f).obj s = U }

lemma inducing.obj_functor_obj {X Y : Top} {f : X ⟶ Y} (hf : inducing f) (U : opens X) :
  (topological_space.opens.map f).obj (hf.functor_obj U) = U :=
begin
  apply le_antisymm,
  { rintros x ⟨_, ⟨s, rfl⟩, _, ⟨rfl : _ = U, rfl⟩, hx : f x ∈ s⟩, exact hx },
  { intros x hx, obtain ⟨U, hU⟩ := U, obtain ⟨t, ht, rfl⟩ := hf.is_open_iff.mp hU,
    exact opens.mem_Sup.mpr ⟨⟨_, ht⟩, rfl, hx⟩ }
end

lemma inducing.mem_functor_obj_iff {X Y : Top} {f : X ⟶ Y} (hf : inducing f) (U : opens X)
  {x : X} : f x ∈ hf.functor_obj U ↔ x ∈ U :=
by { conv_rhs { rw ← hf.obj_functor_obj U }, refl }

lemma inducing.le_functor_obj_iff {X Y : Top} {f : X ⟶ Y} (hf : inducing f) {U : opens X}
  {V : opens Y} : V ≤ hf.functor_obj U ↔ (topological_space.opens.map f).obj V ≤ U :=
begin
  obtain ⟨U, hU⟩ := U,
  obtain ⟨t, ht, rfl⟩ := hf.is_open_iff.mp hU,
  split,
  { exact λ i x hx,
      (hf.mem_functor_obj_iff ((topological_space.opens.map f).obj ⟨t, ht⟩)).mp (i hx) },
  { intros h x hx,
    refine opens.mem_Sup.mpr ⟨⟨_, V.2.union ht⟩, opens.ext _, set.mem_union_left t hx⟩,
    dsimp,
    rwa [set.union_eq_right_iff_subset] },
end

/--
An inducing map `f : X ⟶ Y` induces an galois insertion between `opens Y` and `opens X`.
-/
def inducing.opens_gi {X Y : Top} {f : X ⟶ Y} (hf : inducing f) :
  galois_insertion (topological_space.opens.map f).obj hf.functor_obj  :=
⟨_, λ _ _, hf.le_functor_obj_iff.symm, λ U, (hf.obj_functor_obj U).ge, λ _ _, rfl⟩

/--
An inducing map `f : X ⟶ Y` induces a functor `opens X ⥤ opens Y`.
-/
@[simps]
def inducing.functor {X Y : Top} {f : X ⟶ Y} (hf : inducing f) :
  opens X ⥤ opens Y :=
{ obj := λ U, Sup { s : opens Y | (topological_space.opens.map f).obj s = U },
  map := λ U V h, hom_of_le (hf.le_functor_obj_iff.mpr ((hf.obj_functor_obj U).trans_le h.le)) }

/--
An inducing map `f : X ⟶ Y` induces an adjunction between `opens Y` and `opens X`.
-/
def inducing.adjunction {X Y : Top} {f : X ⟶ Y} (hf : inducing f) :
  adjunction (topological_space.opens.map f) hf.functor :=
hf.opens_gi.gc.adjunction

/--
An open map `f : X ⟶ Y` induces a functor `open_nhds x ⥤ open_nhds (f x)`.
-/
@[simps]
def inducing.functor_nhds (h : inducing f) (x : X) :
  open_nhds x ⥤ open_nhds (f x) :=
{ obj := λ U, ⟨h.functor.obj U.1, (h.mem_functor_obj_iff U.1).mpr U.2⟩,
  map := λ U V i, h.functor.map i }

/--
An open map `f : X ⟶ Y` induces an adjunction between `open_nhds x` and `open_nhds (f x)`.
-/
def inducing.adjunction_nhds (h : inducing f) (x : X) :
  open_nhds.map f x ⊣ h.functor_nhds x :=
adjunction.mk_of_unit_counit
{ unit := { app := λ U, hom_of_le (h.adjunction.unit.app U.1).le },
  counit := { app := λ V, hom_of_le (h.adjunction.counit.app V.1).le } }

end inducing

open category_theory category_theory.limits topological_space Top.presheaf

lemma Top.presheaf.stalk_pushforward_iso_of_inducing {C} [category C] [has_colimits C]
  {X Y : Top} {f : X ⟶ Y}
  (hf : inducing f) (F : X.presheaf C) (x : X) : is_iso (F.stalk_pushforward _ f x) :=
begin
  haveI := functor.initial_of_adjunction (hf.adjunction_nhds x),
  convert is_iso.of_iso (functor.final.colimit_iso (open_nhds.map f x).op
    ((open_nhds.inclusion x).op ⋙ F)),
  { apply stalk_hom_ext,
    intros U hU,
    refine (stalk_pushforward_germ _ f F _ ⟨x, hU⟩).trans _,
    symmetry,
    exact colimit.ι_pre ((open_nhds.inclusion x).op ⋙ F) (open_nhds.map f x).op _ },
end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Kexing Ying, Moritz Doll
-/

import linear_algebra.finsupp_vector_space
import linear_algebra.matrix.basis
import linear_algebra.matrix.nondegenerate
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.matrix.to_linear_equiv
import linear_algebra.sesquilinear_form

/-!
# Sesquilinear form

This file defines the conversion between sesquilinear forms and matrices.

## Main definitions

 * `matrix.to_linear_map₂` given a basis define a bilinear form
 * `matrix.to_linear_map₂'` define the bilinear form on `n → R`
 * `linear_map.to_matrix₂`: calculate the matrix coefficients of a bilinear form
 * `linear_map.to_matrix₂'`: calculate the matrix coefficients of a bilinear form on `n → R`

## Todos

At the moment this is quite a literal port from `matrix.bilinear_form`. Everything should be
generalized to fully semibilinear forms.

## Tags

sesquilinear_form, matrix, basis

-/

variables {R R₁ R₂ M M₁ M₂ M₁' M₂' n m n' m' ι : Type*}

open_locale big_operators
open finset linear_map matrix
open_locale matrix

section aux_to_linear_map

variables [comm_semiring R] [comm_semiring R₁] [comm_semiring R₂]
variables [fintype n] [fintype m]

variables (σ₁ : R₁ →+* R) (σ₂ : R₂ →+* R)

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

This is an auxiliary definition for the equivalence `matrix.to_linear_map₂'`. -/
def matrix.to_linear_map₂'_aux  (f : matrix n m R) :
  (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R :=
mk₂'ₛₗ σ₁ σ₂ (λ (v : n → R₁) (w : m → R₂), ∑ i j, σ₁ (v i) * f i j * σ₂ (w j))
  (λ _ _ _, by simp only [pi.add_apply, map_add, add_mul, sum_add_distrib] )
  (λ _ _ _, by simp only [pi.smul_apply, smul_eq_mul, ring_hom.map_mul, mul_assoc, mul_sum] )
  (λ _ _ _, by simp only [pi.add_apply, map_add, mul_add, sum_add_distrib] )
  (λ _ _ _, by
    simp only [pi.smul_apply, smul_eq_mul, ring_hom.map_mul, mul_assoc, mul_left_comm, mul_sum] )

variables [decidable_eq n] [decidable_eq m]

lemma matrix.to_linear_map₂'_aux_std_basis (f : matrix n m R) (i : n) (j : m) :
  f.to_linear_map₂'_aux σ₁ σ₂ (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) = f i j :=
begin
  rw [matrix.to_linear_map₂'_aux, mk₂'ₛₗ_apply],
  have : (∑ i' j', (if i = i' then 1 else 0) * f i' j' * (if j = j' then 1 else 0)) = f i j :=
  begin
    simp_rw [mul_assoc, ←finset.mul_sum],
    simp only [boole_mul, finset.sum_ite_eq, finset.mem_univ, if_true, mul_comm (f _ _)],
  end,
  rw ←this,
  exact finset.sum_congr rfl (λ _ _, finset.sum_congr rfl (λ _ _, by simp)),
end

end aux_to_linear_map

section aux_to_matrix

section comm_semiring

variables [comm_semiring R] [comm_semiring R₁] [comm_semiring R₂]
variables [add_comm_monoid M₁] [module R₁ M₁] [add_comm_monoid M₂] [module R₂ M₂]

variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}

/-- The linear map from sesquilinear forms to `matrix n m R` given an `n`-indexed basis for `M₁`
and an `m`-indexed basis for `M₂`.

This is an auxiliary definition for the equivalence `matrix.to_linear_mapₛₗ₂'`. -/
def linear_map.to_matrix₂_aux (b₁ : n → M₁) (b₂ : m → M₂) :
  (M₁ →ₛₗ[σ₁] M₂ →ₛₗ[σ₂] R) →ₗ[R] matrix n m R :=
{ to_fun := λ f, of $ λ i j, f (b₁ i) (b₂ j),
  map_add' := λ f g, rfl,
  map_smul' := λ f g, rfl }

@[simp] lemma linear_map.to_matrix₂_aux_apply (f : M₁ →ₛₗ[σ₁] M₂ →ₛₗ[σ₂] R)
  (b₁ : n → M₁) (b₂ : m → M₂) (i : n) (j : m) :
  linear_map.to_matrix₂_aux b₁ b₂ f i j = f (b₁ i) (b₂ j) := rfl

end comm_semiring

section comm_ring

variables [comm_ring R] [comm_ring R₁] [comm_ring R₂]
variables [add_comm_monoid M₁] [module R₁ M₁] [add_comm_monoid M₂] [module R₂ M₂]
variables [fintype n] [fintype m]
variables [decidable_eq n] [decidable_eq m]

variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}

lemma linear_map.to_linear_map₂'_aux_to_matrix₂_aux (f : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :
  matrix.to_linear_map₂'_aux σ₁ σ₂ (linear_map.to_matrix₂_aux
    (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1) f) = f :=
begin
  refine ext_basis (pi.basis_fun R₁ n) (pi.basis_fun R₂ m) (λ i j, _),
  simp_rw [pi.basis_fun_apply, matrix.to_linear_map₂'_aux_std_basis,
    linear_map.to_matrix₂_aux_apply],
end

lemma matrix.to_matrix₂_aux_to_linear_map₂'_aux (f : matrix n m R) :
  linear_map.to_matrix₂_aux (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1)
    (f.to_linear_map₂'_aux σ₁ σ₂) = f :=
by { ext i j, simp_rw [linear_map.to_matrix₂_aux_apply, matrix.to_linear_map₂'_aux_std_basis] }

end comm_ring

end aux_to_matrix

section to_matrix'

/-! ### Bilinear forms over `n → R`

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

variables [comm_ring R] [comm_ring R₁] [comm_ring R₂]
variables [fintype n] [fintype m]
variables [decidable_eq n] [decidable_eq m]

variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}

/-- The linear equivalence between sesquilinear forms and `n × m` matrices -/
def linear_map.to_matrixₛₗ₂' : ((n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) ≃ₗ[R] matrix n m R :=
{ to_fun := linear_map.to_matrix₂_aux _ _,
  inv_fun := matrix.to_linear_map₂'_aux σ₁ σ₂,
  left_inv := linear_map.to_linear_map₂'_aux_to_matrix₂_aux,
  right_inv := matrix.to_matrix₂_aux_to_linear_map₂'_aux,
  ..linear_map.to_matrix₂_aux (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1) }

/-- The linear equivalence between bilinear forms and `n × m` matrices -/
def linear_map.to_matrix₂' : ((n → R) →ₗ[R] (m → R) →ₗ[R] R) ≃ₗ[R] matrix n m R :=
linear_map.to_matrixₛₗ₂'

variables (σ₁ σ₂)

/-- The linear equivalence between `n × n` matrices and sesquilinear forms on `n → R` -/
def matrix.to_linear_mapₛₗ₂' : matrix n m R ≃ₗ[R] ((n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :=
linear_map.to_matrixₛₗ₂'.symm

/-- The linear equivalence between `n × n` matrices and bilinear forms on `n → R` -/
def matrix.to_linear_map₂' : matrix n m R ≃ₗ[R] ((n → R) →ₗ[R] (m → R) →ₗ[R] R) :=
linear_map.to_matrix₂'.symm

lemma matrix.to_linear_mapₛₗ₂'_aux_eq (M : matrix n m R) :
  matrix.to_linear_map₂'_aux σ₁ σ₂ M = matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M := rfl

lemma matrix.to_linear_mapₛₗ₂'_apply (M : matrix n m R) (x : n → R₁) (y : m → R₂) :
  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M x y = ∑ i j, σ₁ (x i) * M i j * σ₂ (y j) := rfl

lemma matrix.to_linear_map₂'_apply (M : matrix n m R) (x : n → R) (y : m → R) :
  matrix.to_linear_map₂' M x y = ∑ i j, x i * M i j * y j := rfl

lemma matrix.to_linear_map₂'_apply' (M : matrix n m R) (v : n → R) (w : m → R) :
  matrix.to_linear_map₂' M v w = matrix.dot_product v (M.mul_vec w) :=
begin
  simp_rw [matrix.to_linear_map₂'_apply, matrix.dot_product,
           matrix.mul_vec, matrix.dot_product],
  refine finset.sum_congr rfl (λ _ _, _),
  rw finset.mul_sum,
  refine finset.sum_congr rfl (λ _ _, _),
  rw ← mul_assoc,
end

@[simp] lemma matrix.to_linear_mapₛₗ₂'_std_basis (M : matrix n m R) (i : n) (j : m) :
  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) =
    M i j :=
matrix.to_linear_map₂'_aux_std_basis σ₁ σ₂ M i j

@[simp] lemma matrix.to_linear_map₂'_std_basis (M : matrix n m R) (i : n) (j : m) :
  matrix.to_linear_map₂' M (std_basis R (λ _, R) i 1) (std_basis R (λ _, R) j 1) =
    M i j :=
matrix.to_linear_map₂'_aux_std_basis _ _ M i j

@[simp] lemma linear_map.to_matrixₛₗ₂'_symm :
  (linear_map.to_matrixₛₗ₂'.symm : matrix n m R ≃ₗ[R] _) = matrix.to_linear_mapₛₗ₂' σ₁ σ₂ :=
rfl

@[simp] lemma matrix.to_linear_mapₛₗ₂'_symm :
  ((matrix.to_linear_mapₛₗ₂' σ₁ σ₂).symm : _ ≃ₗ[R] matrix n m R) = linear_map.to_matrixₛₗ₂' :=
linear_map.to_matrixₛₗ₂'.symm_symm

@[simp] lemma matrix.to_linear_mapₛₗ₂'_to_matrix' (B : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :
  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ (linear_map.to_matrixₛₗ₂' B) = B :=
(matrix.to_linear_mapₛₗ₂' σ₁ σ₂).apply_symm_apply B

@[simp] lemma matrix.to_linear_map₂'_to_matrix' (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) :
  matrix.to_linear_map₂' (linear_map.to_matrix₂' B) = B :=
matrix.to_linear_map₂'.apply_symm_apply B

@[simp] lemma linear_map.to_matrix'_to_linear_mapₛₗ₂' (M : matrix n m R) :
  linear_map.to_matrixₛₗ₂' (matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M) = M :=
linear_map.to_matrixₛₗ₂'.apply_symm_apply M

@[simp] lemma linear_map.to_matrix'_to_linear_map₂' (M : matrix n m R) :
  linear_map.to_matrix₂' (matrix.to_linear_map₂' M) = M :=
linear_map.to_matrixₛₗ₂'.apply_symm_apply M

@[simp] lemma linear_map.to_matrixₛₗ₂'_apply (B : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) (i : n)
  (j : m): linear_map.to_matrixₛₗ₂' B i j =
    B (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) :=
rfl

@[simp] lemma linear_map.to_matrix₂'_apply (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (i : n) (j : m):
  linear_map.to_matrix₂' B i j =
    B (std_basis R (λ _, R) i 1) (std_basis R (λ _, R) j 1) :=
rfl

variables [fintype n'] [fintype m']
variables [decidable_eq n'] [decidable_eq m']

@[simp] lemma linear_map.to_matrix₂'_compl₁₂ (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
  (l : (n' → R) →ₗ[R] (n → R)) (r : (m' → R) →ₗ[R] (m → R)) :
  (B.compl₁₂ l r).to_matrix₂' = l.to_matrix'ᵀ ⬝ B.to_matrix₂' ⬝ r.to_matrix' :=
begin
  ext i j,
  simp only [linear_map.to_matrix₂'_apply, linear_map.compl₁₂_apply, transpose_apply,
    matrix.mul_apply, linear_map.to_matrix', linear_equiv.coe_mk, sum_mul],
  rw sum_comm,
  conv_lhs { rw ←linear_map.sum_repr_mul_repr_mul (pi.basis_fun R n) (pi.basis_fun R m)
    (l _) (r _) },
  rw finsupp.sum_fintype,
  { apply sum_congr rfl,
    rintros i' -,
    rw finsupp.sum_fintype,
    { apply sum_congr rfl,
      rintros j' -,
      simp only [smul_eq_mul, pi.basis_fun_repr, mul_assoc, mul_comm, mul_left_comm,
                 pi.basis_fun_apply, of_apply] },
    { intros, simp only [zero_smul, smul_zero] } },
  { intros, simp only [zero_smul, finsupp.sum_zero] }
end

lemma linear_map.to_matrix₂'_comp (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
  (f : (n' → R) →ₗ[R] (n → R)) : (B.comp f).to_matrix₂' = f.to_matrix'ᵀ ⬝ B.to_matrix₂' :=
by { rw [←linear_map.compl₂_id (B.comp f), ←linear_map.compl₁₂], simp }

lemma linear_map.to_matrix₂'_compl₂ (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
  (f : (m' → R) →ₗ[R] (m → R)) : (B.compl₂ f).to_matrix₂' = B.to_matrix₂' ⬝ f.to_matrix' :=
by { rw [←linear_map.comp_id B, ←linear_map.compl₁₂], simp }

lemma linear_map.mul_to_matrix₂'_mul (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
  (M : matrix n' n R) (N : matrix m m' R) :
  M ⬝ B.to_matrix₂' ⬝ N = (B.compl₁₂ Mᵀ.to_lin' N.to_lin').to_matrix₂' :=
by simp

lemma linear_map.mul_to_matrix' (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (M : matrix n' n R) :
  M ⬝ B.to_matrix₂' = (B.comp Mᵀ.to_lin').to_matrix₂' :=
by simp only [B.to_matrix₂'_comp, transpose_transpose, to_matrix'_to_lin']

lemma linear_map.to_matrix₂'_mul (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (M : matrix m m' R) :
  B.to_matrix₂' ⬝ M = (B.compl₂ M.to_lin').to_matrix₂' :=
by simp only [B.to_matrix₂'_compl₂, to_matrix'_to_lin']

lemma matrix.to_linear_map₂'_comp (M : matrix n m R) (P : matrix n n' R) (Q : matrix m m' R) :
  M.to_linear_map₂'.compl₁₂ P.to_lin' Q.to_lin' = (Pᵀ ⬝ M ⬝ Q).to_linear_map₂' :=
linear_map.to_matrix₂'.injective (by simp)

end to_matrix'

section to_matrix

/-! ### Bilinear forms over arbitrary vector spaces

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

variables [comm_ring R]
variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]

variables [decidable_eq n] [fintype n]
variables [decidable_eq m] [fintype m]
variables (b₁ : basis n R M₁) (b₂ : basis m R M₂)

/-- `linear_map.to_matrix₂ b₁ b₂` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
noncomputable def linear_map.to_matrix₂ : (M₁ →ₗ[R] M₂ →ₗ[R] R) ≃ₗ[R] matrix n m R :=
(b₁.equiv_fun.arrow_congr (b₂.equiv_fun.arrow_congr (linear_equiv.refl R R))).trans
  linear_map.to_matrix₂'

/-- `bilin_form.to_matrix b` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
noncomputable def matrix.to_linear_map₂ : matrix n m R ≃ₗ[R] (M₁ →ₗ[R] M₂ →ₗ[R] R) :=
(linear_map.to_matrix₂ b₁ b₂).symm

-- We make this and not `linear_map.to_matrix₂` a `simp` lemma to avoid timeouts
@[simp] lemma linear_map.to_matrix₂_apply (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (i : n) (j : m) :
  linear_map.to_matrix₂ b₁ b₂ B i j = B (b₁ i) (b₂ j) :=
by simp only [linear_map.to_matrix₂, linear_equiv.trans_apply, linear_map.to_matrix₂'_apply,
  linear_equiv.trans_apply, linear_map.to_matrix₂'_apply, linear_equiv.arrow_congr_apply,
  basis.equiv_fun_symm_std_basis, linear_equiv.refl_apply]

@[simp] lemma matrix.to_linear_map₂_apply (M : matrix n m R) (x : M₁) (y : M₂) :
  matrix.to_linear_map₂ b₁ b₂ M x y = ∑ i j, b₁.repr x i * M i j * b₂.repr y j :=
rfl

-- Not a `simp` lemma since `linear_map.to_matrix₂` needs an extra argument
lemma linear_map.to_matrix₂_aux_eq (B : M₁ →ₗ[R] M₂ →ₗ[R] R) :
  linear_map.to_matrix₂_aux b₁ b₂ B = linear_map.to_matrix₂ b₁ b₂ B :=
ext (λ i j, by rw [linear_map.to_matrix₂_apply, linear_map.to_matrix₂_aux_apply])

@[simp] lemma linear_map.to_matrix₂_symm :
  (linear_map.to_matrix₂ b₁ b₂).symm = matrix.to_linear_map₂ b₁ b₂ :=
rfl

@[simp] lemma matrix.to_linear_map₂_symm :
  (matrix.to_linear_map₂ b₁ b₂).symm = linear_map.to_matrix₂ b₁ b₂ :=
(linear_map.to_matrix₂ b₁ b₂).symm_symm

lemma matrix.to_linear_map₂_basis_fun :
  matrix.to_linear_map₂ (pi.basis_fun R n) (pi.basis_fun R m) = matrix.to_linear_map₂' :=
by { ext M, simp only [matrix.to_linear_map₂_apply, matrix.to_linear_map₂'_apply, pi.basis_fun_repr,
  coe_comp, function.comp_app]}

lemma linear_map.to_matrix₂_basis_fun :
  linear_map.to_matrix₂ (pi.basis_fun R n) (pi.basis_fun R m) = linear_map.to_matrix₂' :=
by { ext B, rw [linear_map.to_matrix₂_apply, linear_map.to_matrix₂'_apply,
                pi.basis_fun_apply, pi.basis_fun_apply] }

@[simp] lemma matrix.to_linear_map₂_to_matrix₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) :
  matrix.to_linear_map₂ b₁ b₂ (linear_map.to_matrix₂ b₁ b₂ B) = B :=
(matrix.to_linear_map₂ b₁ b₂).apply_symm_apply B

@[simp] lemma linear_map.to_matrix₂_to_linear_map₂ (M : matrix n m R) :
  linear_map.to_matrix₂ b₁ b₂ (matrix.to_linear_map₂ b₁ b₂ M) = M :=
(linear_map.to_matrix₂ b₁ b₂).apply_symm_apply M

variables [add_comm_monoid M₁'] [module R M₁']
variables [add_comm_monoid M₂'] [module R M₂']
variables (b₁' : basis n' R M₁')
variables (b₂' : basis m' R M₂')
variables [fintype n'] [fintype m']
variables [decidable_eq n'] [decidable_eq m']

-- Cannot be a `simp` lemma because `b₁` and `b₂` must be inferred.
lemma linear_map.to_matrix₂_compl₁₂
  (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (l : M₁' →ₗ[R] M₁) (r : M₂' →ₗ[R] M₂) :
  linear_map.to_matrix₂ b₁' b₂' (B.compl₁₂ l r) =
    (to_matrix b₁' b₁ l)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ to_matrix b₂' b₂ r :=
begin
  ext i j,
  simp only [linear_map.to_matrix₂_apply, compl₁₂_apply, transpose_apply, matrix.mul_apply,
    linear_map.to_matrix_apply, linear_equiv.coe_mk, sum_mul],
  rw sum_comm,
  conv_lhs { rw ←linear_map.sum_repr_mul_repr_mul b₁ b₂ },
  rw finsupp.sum_fintype,
  { apply sum_congr rfl,
    rintros i' -,
    rw finsupp.sum_fintype,
    { apply sum_congr rfl,
      rintros j' -,
      simp only [smul_eq_mul, linear_map.to_matrix_apply,
        basis.equiv_fun_apply, mul_assoc, mul_comm, mul_left_comm] },
    { intros, simp only [zero_smul, smul_zero] } },
  { intros, simp only [zero_smul, finsupp.sum_zero] }
end

lemma linear_map.to_matrix₂_comp (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (f : M₁' →ₗ[R] M₁) :
  linear_map.to_matrix₂ b₁' b₂ (B.comp f) = (to_matrix b₁' b₁ f)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B :=
begin
  rw [←linear_map.compl₂_id (B.comp f), ←linear_map.compl₁₂, linear_map.to_matrix₂_compl₁₂ b₁ b₂],
  simp,
end

lemma linear_map.to_matrix₂_compl₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (f : M₂' →ₗ[R] M₂) :
  linear_map.to_matrix₂ b₁ b₂' (B.compl₂ f) =
  linear_map.to_matrix₂ b₁ b₂ B ⬝ (to_matrix b₂' b₂ f) :=
by { rw [←linear_map.comp_id B, ←linear_map.compl₁₂, linear_map.to_matrix₂_compl₁₂ b₁ b₂], simp }

@[simp]
lemma linear_map.to_matrix₂_mul_basis_to_matrix (c₁ : basis n' R M₁) (c₂ : basis m' R M₂)
  (B : M₁ →ₗ[R] M₂ →ₗ[R] R) : (b₁.to_matrix c₁)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ b₂.to_matrix c₂ =
  linear_map.to_matrix₂ c₁ c₂ B :=
begin
  simp_rw ←linear_map.to_matrix_id_eq_basis_to_matrix,
  rw [←linear_map.to_matrix₂_compl₁₂, linear_map.compl₁₂_id_id],
end

lemma linear_map.mul_to_matrix₂_mul (B : M₁ →ₗ[R] M₂ →ₗ[R] R)
  (M : matrix n' n R) (N : matrix m m' R) :
  M ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ N =
    linear_map.to_matrix₂ b₁' b₂' (B.compl₁₂ (to_lin b₁' b₁ Mᵀ) (to_lin b₂' b₂ N)) :=
by simp_rw [linear_map.to_matrix₂_compl₁₂ b₁ b₂, to_matrix_to_lin, transpose_transpose]

lemma linear_map.mul_to_matrix₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (M : matrix n' n R) :
  M ⬝ linear_map.to_matrix₂ b₁ b₂ B =
    linear_map.to_matrix₂ b₁' b₂ (B.comp (to_lin b₁' b₁ Mᵀ)) :=
by rw [linear_map.to_matrix₂_comp b₁, to_matrix_to_lin, transpose_transpose]

lemma linear_map.to_matrix₂_mul (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (M : matrix m m' R) :
  linear_map.to_matrix₂ b₁ b₂ B ⬝ M =
    linear_map.to_matrix₂ b₁ b₂' (B.compl₂ (to_lin b₂' b₂ M)) :=
by rw [linear_map.to_matrix₂_compl₂ b₁, to_matrix_to_lin]

lemma matrix.to_linear_map₂_compl₁₂ (M : matrix n m R) (P : matrix n n' R) (Q : matrix m m' R) :
  (matrix.to_linear_map₂ b₁ b₂ M).compl₁₂ (to_lin b₁' b₁ P) (to_lin b₂' b₂ Q) =
  matrix.to_linear_map₂ b₁' b₂' (Pᵀ ⬝ M ⬝ Q) :=
(linear_map.to_matrix₂ b₁' b₂').injective
  (by simp only [linear_map.to_matrix₂_compl₁₂ b₁ b₂, linear_map.to_matrix₂_to_linear_map₂,
    to_matrix_to_lin])

end to_matrix

/-! ### Adjoint pairs-/

section matrix_adjoints
open_locale matrix

variables [comm_ring R]
variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]
variables [fintype n] [fintype n']

variables (b₁ : basis n R M₁) (b₂ : basis n' R M₂)
variables (J J₂ : matrix n n R) (J' : matrix n' n' R)
variables (A : matrix n' n R) (A' : matrix n n' R)
variables (A₁ : matrix n n R)

/-- The condition for the matrices `A`, `A'` to be an adjoint pair with respect to the square
matrices `J`, `J₃`. -/
def matrix.is_adjoint_pair := Aᵀ ⬝ J' = J ⬝ A'

/-- The condition for a square matrix `A` to be self-adjoint with respect to the square matrix
`J`. -/
def matrix.is_self_adjoint := matrix.is_adjoint_pair J J A₁ A₁

/-- The condition for a square matrix `A` to be skew-adjoint with respect to the square matrix
`J`. -/
def matrix.is_skew_adjoint := matrix.is_adjoint_pair J J A₁ (-A₁)

variables [decidable_eq n] [decidable_eq n']

@[simp] lemma is_adjoint_pair_to_linear_map₂' :
  is_adjoint_pair (matrix.to_linear_map₂' J) (matrix.to_linear_map₂' J')
      (matrix.to_lin' A) (matrix.to_lin' A') ↔
    matrix.is_adjoint_pair J J' A A' :=
begin
  rw is_adjoint_pair_iff_comp_eq_compl₂,
  have h : ∀ (B B' : (n → R) →ₗ[R] (n' → R) →ₗ[R] R), B = B' ↔
    (linear_map.to_matrix₂' B) = (linear_map.to_matrix₂' B') :=
  begin
    intros B B',
    split; intros h,
    { rw h },
    { exact linear_map.to_matrix₂'.injective h },
  end,
  simp_rw [h, linear_map.to_matrix₂'_comp, linear_map.to_matrix₂'_compl₂,
    linear_map.to_matrix'_to_lin', linear_map.to_matrix'_to_linear_map₂'],
  refl,
end

@[simp] lemma is_adjoint_pair_to_linear_map₂ :
  is_adjoint_pair (matrix.to_linear_map₂ b₁ b₁ J) (matrix.to_linear_map₂ b₂ b₂ J')
      (matrix.to_lin b₁ b₂ A) (matrix.to_lin b₂ b₁ A') ↔
    matrix.is_adjoint_pair J J' A A' :=
begin
  rw is_adjoint_pair_iff_comp_eq_compl₂,
  have h : ∀ (B B' : M₁ →ₗ[R] M₂ →ₗ[R] R), B = B' ↔
    (linear_map.to_matrix₂ b₁ b₂ B) = (linear_map.to_matrix₂ b₁ b₂ B') :=
  begin
    intros B B',
    split; intros h,
    { rw h },
    { exact (linear_map.to_matrix₂ b₁ b₂).injective h },
  end,
  simp_rw [h, linear_map.to_matrix₂_comp b₂ b₂, linear_map.to_matrix₂_compl₂ b₁ b₁,
    linear_map.to_matrix_to_lin, linear_map.to_matrix₂_to_linear_map₂],
  refl,
end

lemma matrix.is_adjoint_pair_equiv (P : matrix n n R) (h : is_unit P) :
  (Pᵀ ⬝ J ⬝ P).is_adjoint_pair (Pᵀ ⬝ J ⬝ P) A₁ A₁ ↔
    J.is_adjoint_pair J (P ⬝ A₁ ⬝ P⁻¹) (P ⬝ A₁ ⬝ P⁻¹) :=
have h' : is_unit P.det := P.is_unit_iff_is_unit_det.mp h,
begin
  let u := P.nonsing_inv_unit h',
  let v := Pᵀ.nonsing_inv_unit (P.is_unit_det_transpose h'),
  let x := A₁ᵀ * Pᵀ * J,
  let y := J * P * A₁,
  suffices : x * ↑u = ↑v * y ↔ ↑v⁻¹ * x = y * ↑u⁻¹,
  { dunfold matrix.is_adjoint_pair,
    repeat { rw matrix.transpose_mul, },
    simp only [←matrix.mul_eq_mul, ←mul_assoc, P.transpose_nonsing_inv],
    conv_lhs { to_rhs, rw [mul_assoc, mul_assoc], congr, skip, rw ←mul_assoc, },
    conv_rhs { rw [mul_assoc, mul_assoc], conv { to_lhs, congr, skip, rw ←mul_assoc }, },
    exact this, },
  rw units.eq_mul_inv_iff_mul_eq, conv_rhs { rw mul_assoc, }, rw v.inv_mul_eq_iff_eq_mul,
end

/-- The submodule of pair-self-adjoint matrices with respect to bilinear forms corresponding to
given matrices `J`, `J₂`. -/
def pair_self_adjoint_matrices_submodule : submodule R (matrix n n R) :=
(is_pair_self_adjoint_submodule (matrix.to_linear_map₂' J) (matrix.to_linear_map₂' J₂)).map
  ((linear_map.to_matrix' : ((n → R) →ₗ[R] (n → R)) ≃ₗ[R] matrix n n R) :
  ((n → R) →ₗ[R] (n → R)) →ₗ[R] matrix n n R)

@[simp] lemma mem_pair_self_adjoint_matrices_submodule :
  A₁ ∈ (pair_self_adjoint_matrices_submodule J J₂) ↔ matrix.is_adjoint_pair J J₂ A₁ A₁ :=
begin
  simp only [pair_self_adjoint_matrices_submodule, linear_equiv.coe_coe,
    linear_map.to_matrix'_apply, submodule.mem_map, mem_is_pair_self_adjoint_submodule],
  split,
  { rintros ⟨f, hf, hA⟩,
    have hf' : f = A₁.to_lin' := by rw [←hA, matrix.to_lin'_to_matrix'], rw hf' at hf,
    rw ← is_adjoint_pair_to_linear_map₂',
    exact hf, },
  { intros h, refine ⟨A₁.to_lin', _, linear_map.to_matrix'_to_lin' _⟩,
    exact (is_adjoint_pair_to_linear_map₂' _ _ _ _).mpr h, },
end

/-- The submodule of self-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def self_adjoint_matrices_submodule : submodule R (matrix n n R) :=
  pair_self_adjoint_matrices_submodule J J

@[simp] lemma mem_self_adjoint_matrices_submodule :
  A₁ ∈ self_adjoint_matrices_submodule J ↔ J.is_self_adjoint A₁ :=
by { erw mem_pair_self_adjoint_matrices_submodule, refl, }

/-- The submodule of skew-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def skew_adjoint_matrices_submodule : submodule R (matrix n n R) :=
  pair_self_adjoint_matrices_submodule (-J) J

@[simp] lemma mem_skew_adjoint_matrices_submodule :
  A₁ ∈ skew_adjoint_matrices_submodule J ↔ J.is_skew_adjoint A₁ :=
begin
  erw mem_pair_self_adjoint_matrices_submodule,
  simp [matrix.is_skew_adjoint, matrix.is_adjoint_pair],
end

end matrix_adjoints

namespace linear_map

/-! ### Nondegenerate bilinear forms-/

section det

open matrix

variables [comm_ring R₁] [add_comm_monoid M₁] [module R₁ M₁]
variables [decidable_eq ι] [fintype ι]

lemma _root_.matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂
  {M : matrix ι ι R₁} (b : basis ι R₁ M₁) : M.to_linear_map₂'.separating_left ↔
  (matrix.to_linear_map₂ b b M).separating_left :=
(separating_left_congr_iff b.equiv_fun.symm b.equiv_fun.symm).symm

variables (B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁)

-- Lemmas transferring nondegeneracy between a matrix and its associated bilinear form

theorem _root_.matrix.nondegenerate.to_linear_map₂' {M : matrix ι ι R₁} (h : M.nondegenerate) :
  M.to_linear_map₂'.separating_left :=
λ x hx, h.eq_zero_of_ortho $ λ y, by simpa only [to_linear_map₂'_apply'] using hx y

@[simp] lemma _root_.matrix.separating_left_to_linear_map₂'_iff {M : matrix ι ι R₁} :
  M.to_linear_map₂'.separating_left ↔ M.nondegenerate :=
⟨λ h v hv, h v $ λ w, (M.to_linear_map₂'_apply' _ _).trans $ hv w,
  matrix.nondegenerate.to_linear_map₂'⟩

theorem _root_.matrix.nondegenerate.to_linear_map₂ {M : matrix ι ι R₁} (h : M.nondegenerate)
  (b : basis ι R₁ M₁) : (to_linear_map₂ b b M).separating_left :=
(matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂ b).mp h.to_linear_map₂'

@[simp] lemma _root_.matrix.separating_left_to_linear_map₂_iff {M : matrix ι ι R₁}
  (b : basis ι R₁ M₁) : (to_linear_map₂ b b M).separating_left ↔ M.nondegenerate :=
by rw [←matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂,
       matrix.separating_left_to_linear_map₂'_iff]

-- Lemmas transferring nondegeneracy between a bilinear form and its associated matrix

@[simp] theorem nondegenerate_to_matrix₂'_iff {B : (ι → R₁) →ₗ[R₁] (ι → R₁) →ₗ[R₁] R₁} :
  B.to_matrix₂'.nondegenerate ↔ B.separating_left :=
matrix.separating_left_to_linear_map₂'_iff.symm.trans $
  (matrix.to_linear_map₂'_to_matrix' B).symm ▸ iff.rfl

theorem separating_left.to_matrix₂' {B : (ι → R₁) →ₗ[R₁] (ι → R₁) →ₗ[R₁] R₁}
  (h : B.separating_left) : B.to_matrix₂'.nondegenerate :=
nondegenerate_to_matrix₂'_iff.mpr h

@[simp] theorem nondegenerate_to_matrix_iff {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁}
  (b : basis ι R₁ M₁) : (to_matrix₂ b b B).nondegenerate ↔ B.separating_left :=
(matrix.separating_left_to_linear_map₂_iff b).symm.trans $
  (matrix.to_linear_map₂_to_matrix₂ b b B).symm ▸ iff.rfl

theorem separating_left.to_matrix₂ {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁} (h : B.separating_left)
  (b : basis ι R₁ M₁) : (to_matrix₂ b b B).nondegenerate :=
(nondegenerate_to_matrix_iff b).mpr h

-- Some shorthands for combining the above with `matrix.nondegenerate_of_det_ne_zero`

variables [is_domain R₁]

lemma separating_left_to_linear_map₂'_iff_det_ne_zero {M : matrix ι ι R₁} :
  M.to_linear_map₂'.separating_left ↔ M.det ≠ 0 :=
by rw [matrix.separating_left_to_linear_map₂'_iff, matrix.nondegenerate_iff_det_ne_zero]

theorem separating_left_to_linear_map₂'_of_det_ne_zero' (M : matrix ι ι R₁) (h : M.det ≠ 0) :
  M.to_linear_map₂'.separating_left :=
separating_left_to_linear_map₂'_iff_det_ne_zero.mpr h

lemma separating_left_iff_det_ne_zero {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁}
  (b : basis ι R₁ M₁) : B.separating_left ↔ (to_matrix₂ b b B).det ≠ 0 :=
by rw [←matrix.nondegenerate_iff_det_ne_zero, nondegenerate_to_matrix_iff]

theorem separating_left_of_det_ne_zero {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁} (b : basis ι R₁ M₁)
  (h : (to_matrix₂ b b B).det ≠ 0) :
  B.separating_left :=
(separating_left_iff_det_ne_zero b).mpr h

end det

end linear_map


/-
Copyright (c) 2022 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno
-/
import category_theory.bicategory.basic

/-!
# Oplax functors

An oplax functor `F` between bicategories `B` and `C` consists of
* a function between objects `F.obj : B ⟶ C`,
* a family of functions between 1-morphisms `F.map : (a ⟶ b) → (obj a ⟶ obj b)`,
* a family of functions between 2-morphisms `F.map₂ : (f ⟶ g) → (map f ⟶ map g)`,
* a family of 2-morphisms `F.map_id a : F.map (𝟙 a) ⟶ 𝟙 (F.obj a)`,
* a family of 2-morphisms `F.map_comp f g : F.map (f ≫ g) ⟶ F.map f ≫ F.map g`, and
* certain consistency conditions on them.

## Main definitions

* `oplax_functor B C` : an oplax functor between bicategories `B` and `C`
* `oplax_functor.comp F G` : the composition of oplax functors

## Future work

There are two types of functors between bicategories, called lax and oplax functors, depending on
the directions of `map_id` and `map_comp`. We may need both in mathlib in the future, but for
now we only define oplax functors.

In addition, if we require `map_id` and `map_comp` to be isomorphisms, we obtain the definition
of pseudofunctors. There are several possible design choices to implement pseudofunctors,
but the choice is left to future development.
-/

set_option old_structure_cmd true

namespace category_theory

open category bicategory
open_locale bicategory

universes w₁ w₂ w₃ v₁ v₂ v₃ u₁ u₂ u₃

section
variables (B : Type u₁) [quiver.{v₁+1} B] [∀ a b : B, quiver.{w₁+1} (a ⟶ b)]
variables (C : Type u₂) [quiver.{v₂+1} C] [∀ a b : C, quiver.{w₂+1} (a ⟶ b)]

/--
A prelax functor between bicategories consists of functions between objects,
1-morphisms, and 2-morphisms. This structure will be extended to define `oplax_functor`.
-/
structure prelax_functor extends prefunctor B C : Type (max w₁ w₂ v₁ v₂ u₁ u₂) :=
(map₂ {a b : B} {f g : a ⟶ b} : (f ⟶ g) → (map f ⟶ map g))

/-- The prefunctor between the underlying quivers. -/
add_decl_doc prelax_functor.to_prefunctor

namespace prelax_functor

variables {B C} {D : Type u₃} [quiver.{v₃+1} D] [∀ a b : D, quiver.{w₃+1} (a ⟶ b)]
variables (F : prelax_functor B C) (G : prelax_functor C D)

@[simp] lemma to_prefunctor_obj : F.to_prefunctor.obj = F.obj := rfl
@[simp] lemma to_prefunctor_map : F.to_prefunctor.map = F.map := rfl

variables (B)

/-- The identity prelax functor. -/
@[simps]
def id : prelax_functor B B :=
{ map₂ := λ a b f g η, η, .. prefunctor.id B }

instance : inhabited (prelax_functor B B) := ⟨prelax_functor.id B⟩

variables {B}

/-- Composition of prelax functors. -/
@[simps]
def comp : prelax_functor B D :=
{ map₂ := λ a b f g η, G.map₂ (F.map₂ η), .. F.to_prefunctor.comp G.to_prefunctor }

end prelax_functor

end

section
variables {B : Type u₁} [bicategory.{w₁ v₁} B] {C : Type u₂} [bicategory.{w₂ v₂} C]

/--
This auxiliary definition states that oplax functors preserve the associators
modulo some adjustments of domains and codomains of 2-morphisms.
-/
/-
We use this auxiliary definition instead of writing it directly in the definition
of oplax functors because doing so will cause a timeout.
-/
@[simp]
def oplax_functor.map₂_associator_aux
  (obj : B → C) (map : Π {X Y : B}, (X ⟶ Y) → (obj X ⟶ obj Y))
  (map₂ : Π {a b : B} {f g : a ⟶ b}, (f ⟶ g) → (map f ⟶ map g))
  (map_comp : Π {a b c : B} (f : a ⟶ b) (g : b ⟶ c), map (f ≫ g) ⟶ map f ≫ map g)
  {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : Prop :=
map₂ (α_ f g h).hom ≫ map_comp f (g ≫ h) ≫ (map f ◁ map_comp g h) =
  map_comp (f ≫ g) h ≫ (map_comp f g ▷ map h) ≫ (α_ (map f) (map g) (map h)).hom

variables (B C)

/--
An oplax functor `F` between bicategories `B` and `C` consists of functions between objects,
1-morphisms, and 2-morphisms.

Unlike functors between categories, functions between 1-morphisms do not need to strictly commute
with compositions, and do not need to strictly preserve the identity. Instead, there are
specified 2-morphisms `F.map (𝟙 a) ⟶ 𝟙 (F.obj a)` and `F.map (f ≫ g) ⟶ F.map f ≫ F.map g`.

Functions between 2-morphisms strictly commute with compositions and preserve the identity.
They also preserve the associator, the left unitor, and the right unitor modulo some adjustments
of domains and codomains of 2-morphisms.
-/
structure oplax_functor extends prelax_functor B C : Type (max w₁ w₂ v₁ v₂ u₁ u₂) :=
(map_id (a : B) : map (𝟙 a) ⟶ 𝟙 (obj a))
(map_comp {a b c : B} (f : a ⟶ b) (g : b ⟶ c) : map (f ≫ g) ⟶ map f ≫ map g)
(map_comp_naturality_left' : ∀ {a b c : B} {f f' : a ⟶ b} (η : f ⟶ f') (g : b ⟶ c),
  map₂ (η ▷ g) ≫ map_comp f' g = map_comp f g ≫ (map₂ η ▷ map g) . obviously)
(map_comp_naturality_right' : ∀ {a b c : B} (f : a ⟶ b) {g g' : b ⟶ c} (η : g ⟶ g'),
  map₂ (f ◁ η) ≫ map_comp f g' = map_comp f g ≫ (map f ◁ map₂ η) . obviously)
(map₂_id' : ∀ {a b : B} (f : a ⟶ b), map₂ (𝟙 f) = 𝟙 (map f) . obviously)
(map₂_comp' : ∀ {a b : B} {f g h : a ⟶ b} (η : f ⟶ g) (θ : g ⟶ h),
  map₂ (η ≫ θ) = map₂ η ≫ map₂ θ . obviously)
(map₂_associator' : ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d),
  oplax_functor.map₂_associator_aux obj (λ a b, map) (λ a b f g, map₂) (λ a b c, map_comp) f g h
    . obviously)
(map₂_left_unitor' : ∀ {a b : B} (f : a ⟶ b),
  map₂ (λ_ f).hom = map_comp (𝟙 a) f ≫ (map_id a ▷ map f) ≫ (λ_ (map f)).hom . obviously)
(map₂_right_unitor' : ∀ {a b : B} (f : a ⟶ b),
  map₂ (ρ_ f).hom = map_comp f (𝟙 b) ≫ (map f ◁ map_id b) ≫ (ρ_ (map f)).hom . obviously)

restate_axiom oplax_functor.map_comp_naturality_left'
restate_axiom oplax_functor.map_comp_naturality_right'
restate_axiom oplax_functor.map₂_id'
restate_axiom oplax_functor.map₂_comp'
restate_axiom oplax_functor.map₂_associator'
restate_axiom oplax_functor.map₂_left_unitor'
restate_axiom oplax_functor.map₂_right_unitor'
attribute [simp]
  oplax_functor.map_comp_naturality_left oplax_functor.map_comp_naturality_right
  oplax_functor.map₂_id oplax_functor.map₂_associator
attribute [reassoc]
  oplax_functor.map_comp_naturality_left oplax_functor.map_comp_naturality_right
  oplax_functor.map₂_comp oplax_functor.map₂_associator
  oplax_functor.map₂_left_unitor oplax_functor.map₂_right_unitor
attribute [simp]
  oplax_functor.map₂_comp oplax_functor.map₂_left_unitor oplax_functor.map₂_right_unitor

namespace oplax_functor

variables {B} {C} {D : Type u₃} [bicategory.{w₃ v₃} D]
variables (F : oplax_functor B C) (G : oplax_functor C D)

/-- Function between 1-morphisms as a functor. -/
@[simps]
def map_functor (a b : B) : (a ⟶ b) ⥤ (F.obj a ⟶ F.obj b) :=
{ obj := λ f, F.map f,
  map := λ f g η, F.map₂ η }

/-- The prelax functor between the underlying quivers. -/
add_decl_doc oplax_functor.to_prelax_functor

@[simp] lemma to_prelax_functor_obj : F.to_prelax_functor.obj = F.obj := rfl
@[simp] lemma to_prelax_functor_map : F.to_prelax_functor.map = F.map := rfl
@[simp] lemma to_prelax_functor_map₂ : F.to_prelax_functor.map₂ = F.map₂ := rfl

variables (B)

/-- The identity oplax functor. -/
@[simps]
def id : oplax_functor B B :=
{ map_id := λ a, 𝟙 (𝟙 a),
  map_comp := λ a b c f g, 𝟙 (f ≫ g),
  .. prelax_functor.id B }

instance : inhabited (oplax_functor B B) := ⟨id B⟩

variables {B}

/-- Composition of oplax functors. -/
@[simps]
def comp : oplax_functor B D :=
{ map_id := λ a,
    (G.map_functor _ _).map (F.map_id a) ≫ G.map_id (F.obj a),
  map_comp := λ a b c f g,
    (G.map_functor _ _).map (F.map_comp f g) ≫ G.map_comp (F.map f) (F.map g),
  map_comp_naturality_left' := λ a b c f f' η g, by
  { dsimp,
    rw [←map₂_comp_assoc, map_comp_naturality_left, map₂_comp_assoc, map_comp_naturality_left,
      assoc] },
  map_comp_naturality_right' := λ a b c f g g' η, by
  { dsimp,
    rw [←map₂_comp_assoc, map_comp_naturality_right, map₂_comp_assoc, map_comp_naturality_right,
      assoc] },
  map₂_associator' := λ a b c d f g h, by
  { dsimp,
    simp only [map₂_associator, ←map₂_comp_assoc, ←map_comp_naturality_right_assoc,
      whisker_left_comp, assoc],
    simp only [map₂_associator, map₂_comp, map_comp_naturality_left_assoc,
      whisker_right_comp, assoc] },
  map₂_left_unitor' := λ a b f, by
  { dsimp,
    simp only [map₂_left_unitor, map₂_comp, map_comp_naturality_left_assoc,
      whisker_right_comp, assoc] },
  map₂_right_unitor' := λ a b f, by
  { dsimp,
    simp only [map₂_right_unitor, map₂_comp, map_comp_naturality_right_assoc,
      whisker_left_comp, assoc] },
  .. F.to_prelax_functor.comp G.to_prelax_functor }

end oplax_functor

end

end category_theory


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.generator
import category_theory.preadditive.yoneda

/-!
# Separators in preadditive categories

This file contains characterizations of separating sets and objects that are valid in all
preadditive categories.

-/

universes v u

open category_theory opposite

namespace category_theory
variables {C : Type u} [category.{v} C] [preadditive C]

lemma preadditive.is_separating_iff (𝒢 : set C) :
  is_separating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : G ⟶ X), h ≫ f = 0) → f = 0 :=
⟨λ h𝒢 X Y f hf, h𝒢 _ _ (by simpa only [limits.comp_zero] using hf),
 λ h𝒢 X Y f g hfg, sub_eq_zero.1 $ h𝒢 _
  (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩

lemma preadditive.is_coseparating_iff (𝒢 : set C) :
  is_coseparating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : Y ⟶ G), f ≫ h = 0) → f = 0 :=
⟨λ h𝒢 X Y f hf, h𝒢 _ _ (by simpa only [limits.zero_comp] using hf),
 λ h𝒢 X Y f g hfg, sub_eq_zero.1 $ h𝒢 _
  (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩

lemma preadditive.is_separator_iff (G : C) :
  is_separator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : G ⟶ X, h ≫ f = 0) → f = 0 :=
⟨λ hG X Y f hf, hG.def _ _ (by simpa only [limits.comp_zero] using hf),
 λ hG, (is_separator_def _).2 $ λ X Y f g hfg, sub_eq_zero.1 $ hG _
  (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩

lemma preadditive.is_coseparator_iff (G : C) :
  is_coseparator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : Y ⟶ G, f ≫ h = 0) → f = 0 :=
⟨λ hG X Y f hf, hG.def _ _ (by simpa only [limits.zero_comp] using hf),
 λ hG, (is_coseparator_def _).2 $ λ X Y f g hfg, sub_eq_zero.1 $ hG _
  (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩

lemma is_separator_iff_faithful_preadditive_coyoneda (G : C) :
  is_separator G ↔ faithful (preadditive_coyoneda.obj (op G)) :=
begin
  rw [is_separator_iff_faithful_coyoneda_obj, ← whiskering_preadditive_coyoneda, functor.comp_obj,
    whiskering_right_obj_obj],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget AddCommGroup), λ h, by exactI faithful.comp _ _⟩
end

lemma is_separator_iff_faithful_preadditive_coyoneda_obj (G : C) :
  is_separator G ↔ faithful (preadditive_coyoneda_obj (op G)) :=
begin
  rw [is_separator_iff_faithful_preadditive_coyoneda, preadditive_coyoneda_obj_2],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget₂ _ AddCommGroup.{v}),
         λ h, by exactI faithful.comp _ _⟩
end

lemma is_coseparator_iff_faithful_preadditive_yoneda (G : C) :
  is_coseparator G ↔ faithful (preadditive_yoneda.obj G) :=
begin
  rw [is_coseparator_iff_faithful_yoneda_obj, ← whiskering_preadditive_yoneda, functor.comp_obj,
    whiskering_right_obj_obj],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget AddCommGroup), λ h, by exactI faithful.comp _ _⟩
end

lemma is_coseparator_iff_faithful_preadditive_yoneda_obj (G : C) :
  is_coseparator G ↔ faithful (preadditive_yoneda_obj G) :=
begin
  rw [is_coseparator_iff_faithful_preadditive_yoneda, preadditive_yoneda_obj_2],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget₂ _ AddCommGroup.{v}),
         λ h, by exactI faithful.comp _ _⟩
end

end category_theory


import data.matrix.notation
import algebra.group_power
import data.nat.parity

universe variables u v

namespace first_order

section language

/- Shifts a sequence to the right -/
@[simp]
def cons { A : Type } (a : A) (f : ℕ → A) : ℕ → A :=
  λ n, if n = 0 then a else (f (n - 1))

/- Append two sequences -/
@[simp]
def append { A : Type } (f : ℕ → A) (g : ℕ → A) : ℕ → A :=
  λ n : ℕ, if (even n) then f (n / 2) else g ((n - 1) / 2)

notation a`::`f := cons a f

notation l`++`f := append l f

/- Definition of a language -/
structure language :=
(functions : ℕ → Type) (relations : ℕ → Type)

/-- The empty language has no symbols. -/
def empty : language := ⟨λ _, pempty, λ _, pempty⟩

instance : inhabited language := ⟨empty⟩

/-- The type of constants in a given language. -/
def const (L : language) := L.functions 0

variable (L : language)

/-- A term of a language-/
inductive term
| var           : ℕ → term
| func {n : ℕ}  : L.functions n → (fin n → term) → term

open term

/- A formula of a language -/
inductive formula
| falsum      : formula
| eq          : @term L → @term L → formula
| rel {n : ℕ} : L.relations n → (fin n → @term L) → formula
| neg         : formula → formula
| or          : formula → formula → formula
| all         : ℕ → formula → formula

/- Quantifier free formulas -/
inductive qf
| f           : qf
| e           : term L → term L → qf
| r {n : ℕ}   : L.relations n → (fin n → term L) → qf
| n           : qf → qf
| o           : qf → qf → qf

def qf_to_formula : qf L → formula L
| qf.f         := formula.falsum
| (qf.e s t)   := formula.eq s t
| (qf.r r a)   := formula.rel r a
| (qf.n φ)     := formula.neg (qf_to_formula φ)
| (qf.o φ₁ φ₂) := formula.or (qf_to_formula φ₁) (qf_to_formula φ₂)

instance qf_to_formula_coe (L : language) :
  has_coe (qf L) (formula L) :=
  ⟨qf_to_formula L⟩

notation ` v `    := term.var
notation ` v₀ `   := term.var 0
notation ` v₁ `   := term.var 1
notation ` v₂ `   := term.var 2
notation ` v₃ `   := term.var 3
notation ` v₄ `   := term.var 4
notation ` v₅ `   := term.var 5

notation ` F `        := formula.falsum
notation ` T `        := formula.neg F
infix ` ≃ `:88        := formula.eq
prefix ` ∼ `:100      := formula.neg
infix  ` or `:50      := formula.or
notation φ₁` and `φ₂  := ∼(∼φ₁ or ∼φ₂)
notation φ₁` ⇒ `φ₂    := ∼φ₁ or φ₂
notation φ₁` ⇔ `φ₂   := (φ₁ ⇒ φ₂) and (φ₂ ⇒ φ₁)
notation ` all `       := formula.all
notation ` exi `       := λ n φ, ∼(formula.all n ∼φ)

open formula

variables (α : language → Type) (φ φ₁ φ₂ h : formula L) (t Φ₁ Φ₂ : list (formula L)) (n : ℕ)

/- Atomic formulas-/
inductive atom
| f           : atom
| e           : term L → term L → atom
| r {n : ℕ}   : L.relations n → (fin n → term L) → atom

@[simp]
def atom_to_qf : atom L → qf L
| atom.f               := qf.f
| (atom.e t s)         := qf.e t s
| (atom.r rsymb args)  := qf.r rsymb args

/- Literals -/
inductive lit
| a      : atom L → lit
| na     : atom L → lit

/- Negate a literal -/
@[simp]
def neg_lit : lit L → lit L
| (lit.a φ)  := lit.na φ
| (lit.na φ) := lit.a φ

@[simp]
def atom_to_lit : atom L → lit L
| a := lit.a a

@[reducible]
instance atom_to_lit_coe (L : language) :
  has_coe (atom L) (lit L) :=
  ⟨atom_to_lit L⟩

@[simp]
def lit_to_qf : lit L → qf L
| (lit.a a)   := atom_to_qf _ a
| (lit.na na) := qf.n (atom_to_qf _ na)

/- Conjunctions of literals -/
inductive cl
| l : lit L → cl
| c : cl → cl → cl

@[simp]
def lit_to_cl : lit L → cl L
| l := cl.l l

@[reducible]
instance lit_to_cl_coe (L : language) :
  has_coe (lit L) (cl L) :=
  ⟨lit_to_cl L⟩

@[simp]
def cl_to_qf : cl L → qf L
| (cl.l l)        := lit_to_qf _ l
| (cl.c cl₁ cl₂)  := qf.n (qf.o (qf.n (cl_to_qf cl₁)) (qf.n (cl_to_qf cl₂)))

/- Disjunctions of conjunctions of literals -/
inductive dcl
| cl : cl L → dcl
| d  : dcl → dcl → dcl

@[simp]
def cl_to_dcl : cl L → dcl L
| cl := dcl.cl cl

@[reducible]
instance cl_to_dcl_coe (L : language) :
  has_coe (cl L) (dcl L) :=
  ⟨cl_to_dcl L⟩

@[simp]
def dcl_to_qf : dcl L → qf L
| (dcl.cl cl)       := cl_to_qf _ cl
| (dcl.d dcl₁ dcl₂) := qf.o (dcl_to_qf dcl₁) (dcl_to_qf dcl₂)

@[reducible]
instance dcl_to_qf_coe (L : language) :
  has_coe (dcl L) (qf L) :=
  ⟨dcl_to_qf L⟩

/- Disjunctive normal form -/
inductive dnf
| dcl  : dcl L → dnf
| al   : ℕ → dnf → dnf
| ex   : ℕ → dnf → dnf

@[simp]
def dcl_to_dnf : dcl L → dnf L
| dcl := dnf.dcl dcl

@[reducible]
instance dcl_to_dnf_coe (L : language) :
  has_coe (dcl L) (dnf L) :=
  ⟨dcl_to_dnf L⟩

@[simp]
def dnf_to_formula : dnf L → formula L
| (dnf.dcl dcl)  := qf_to_formula _ (dcl_to_qf _ dcl)
| (dnf.al n dnf) := all n (dnf_to_formula dnf)
| (dnf.ex n dnf) := exi n (dnf_to_formula dnf)

@[reducible]
instance dnf_to_formula_coe (L : language) :
  has_coe (dnf L) (formula L) :=
  ⟨dnf_to_formula L⟩

/- A single existential quantifier on a conjunction of literals -/
inductive ecl1
| cl : cl L → ecl1
| ex : ℕ → cl L → ecl1

/- A single existential quantifier on a disjunction of conjunction of literals -/
inductive edcl1
| dcl : dcl L → edcl1
| ex  : ℕ → dcl L → edcl1

@[simp]
def ecl1_to_edcl1 : ecl1 L → edcl1 L
| (ecl1.cl cl)  := edcl1.dcl cl
| (ecl1.ex n cl) := edcl1.ex n cl

@[reducible]
instance ecl1_to_edcl1_coe (L : language) :
  has_coe (ecl1 L) (edcl1 L) :=
  ⟨ecl1_to_edcl1 L⟩

/- A single quantifier on a disjunction of conjunction of literals -/
inductive qdcl1
| dcl : dcl L → qdcl1
| al  : ℕ → dcl L → qdcl1
| ex  : ℕ → dcl L → qdcl1

@[simp]
def edcl1_to_qdcl1 : edcl1 L → qdcl1 L
| (edcl1.dcl dcl)  := qdcl1.dcl dcl
| (edcl1.ex n dcl) := qdcl1.ex n dcl

@[reducible]
instance qcl1_to_qdcl1_coe (L : language) :
  has_coe (edcl1 L) (qdcl1 L) :=
  ⟨edcl1_to_qdcl1 L⟩

@[simp]
def qdcl1_to_dnf : qdcl1 L → dnf L
| (qdcl1.dcl dcl)  := dnf.dcl dcl
| (qdcl1.al n dcl) := dnf.al n (dnf.dcl dcl)
| (qdcl1.ex n dcl) := dnf.ex n (dnf.dcl dcl)

@[reducible]
instance qdcl1_to_dnf_coe (L : language) :
  has_coe (qdcl1 L) (dnf L) :=
  ⟨qdcl1_to_dnf L⟩

/- If a variable occurs in a term -/
@[simp]
def occurs_in_term {L : language} (n : ℕ) : term L → Prop
| (v m)        := n = m
| (func _ t)   := ∃ i, occurs_in_term (t i)

instance occurs_in_term_dec (n : ℕ) (t : term L) : decidable (occurs_in_term n t) := sorry

/- The variable vₓ is free -/
@[simp]
def free {L : language} (x : ℕ) : formula L → Prop
| F                 := false
| (t₁ ≃ t₂)         := (occurs_in_term x t₁) ∨ (occurs_in_term x t₂)
| (rel rsymb args)  := ∃ i, occurs_in_term x (args i)
| ∼φ                := free φ
| (φ₁ or φ₂)        := free φ₁ ∨ free φ₂
| (all m φ)         := ¬(m = x) ∧ free φ

/- For all terms, there is a variable which does not occur in the term -/
lemma for_all_term_ex_var_not_in_term :
  ∀ t : (term L), ∃ m : ℕ, ¬(occurs_in_term m t) :=
begin
  intro t,
  cases t,
  { existsi t + 1, simp },
  { sorry }
end

/- For all formulas, there is a variable which is not free in the formula -/
lemma for_all_formula_ex_var_not_free :
  ∀ φ : (formula L), ∃ m : ℕ, ¬(free m φ) :=
begin
  intro φ,
  cases φ,
  { simp, },
  repeat { sorry },
end

/- The variable x is not free at position n of Γ -/
@[simp]
def nth_not_free {L : language} (x : ℕ) (n : ℕ) (Γ : list (formula L)) : Prop
  := match Γ.nth n with
     | none   := true
     | some φ := ¬(free x φ)
     end

/- The variable x is not free in axioms A -/
@[simp]
def var_not_free_in_axioms {L : language} (x : ℕ) (α : Type) [has_coe α (formula L)] : Prop :=
  (∀ a : α, ¬(@free L x a))

/- The variable x is not free in the context Γ -/
@[simp]
def var_not_free_in_context {L : language} (x : ℕ) (Γ : list (formula L)) : Prop :=
  (∀ n : ℕ, (nth_not_free x n Γ))

/- The variable x is not free in the context Γ -/
@[simp]
def var_not_free_in_axioms_context {L : language} (x : ℕ) (α : Type) [has_coe α (formula L)] (Γ : list (formula L)) : Prop :=
  (@var_not_free_in_axioms L x α _) ∧ (var_not_free_in_context x Γ)

/-- Replace the variable vₓ with the term t -/
@[simp]
def replace_term_with {L : language} (x : ℕ) (t : term L) : term L → term L
| (v n)              := if (n = x) then t else (v n)
| (func fsymb args)  := (func fsymb (λ n, replace_term_with (args n)))

/-- If vₓ does not occur in the term t, then replacing vₓ in t does nothing -/
def replace_term_with_does_not_occur (x : ℕ) (t' : term L) (t : term L) :
  ¬(occurs_in_term x t) → replace_term_with x t' t = t := sorry

/-- Replace the variable vₓ with the term t -/
@[simp]
def replace_formula_with {L : language} (x : ℕ) (t : term L) : formula L → formula L
| F                  := falsum
| (t₁ ≃ t₂)          := (replace_term_with x t t₁) ≃ (replace_term_with x t t₂)
| (rel rsymb args)    := rel rsymb (λ n, replace_term_with x t (args n))
| ∼φ                  := ∼(replace_formula_with φ)
| (φ₁ or φ₂)          := (replace_formula_with φ₁) or (replace_formula_with φ₂)
| (all y φ)           := if x = y then (all y φ) else (all y (replace_formula_with φ))

/- Replacing the variable vₓ with vₓ does not change the formula -/
lemma replace_formula_with_idem : ∀ x φ, @replace_formula_with L x (v x) φ = φ := sorry

/-- The term t is substitutable for the variable vₓ -/
@[simp]
def substitutable_for {L : language} (t : term L) (x : ℕ) : formula L → Prop
| F                    := true
| (_ ≃ _)              := true
| (rel _ _)            := true
| ∼φ                   := substitutable_for φ
| (φ₁ or φ₂)           := (substitutable_for φ₁) ∧ (substitutable_for φ₂)
| (all y φ)            := ¬(free x (all y φ)) ∨ (¬(occurs_in_term y t) ∧ (substitutable_for φ))

/- The variable vₓ is always substitutible for the variable vₓ -/
lemma substitutable_for_idem : ∀ x φ, @substitutable_for L (v x) x φ := begin
  intros x φ,
  induction φ,
  any_goals { by { simp  } },
  assumption,
  apply and.intro,
  repeat { assumption },
  unfold substitutable_for,
  have x_eq := em (φ_ᾰ = x),
  apply or.elim x_eq,
  intro h₁,
  apply or.intro_left,
  unfold free,
  intro c,
  apply c.left h₁,
  intro h₂,
  apply or.intro_right,
  apply and.intro,
  repeat { assumption },
end

/- The sentences of a language -/
@[simp]
def sentence (L : language) := {φ : formula L // ∀ n : ℕ, ¬(free n φ)}

end language

end first_order


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Yury Kudryashov

! This file was ported from Lean 3 source module data.real.irrational
! leanprover-community/mathlib commit 7e7aaccf9b0182576cabdde36cf1b5ad3585b70d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Real.Sqrt
import Mathbin.Tactic.IntervalCases
import Mathbin.RingTheory.Algebraic
import Mathbin.Data.Rat.Sqrt
import Mathbin.RingTheory.Int.Basic

/-!
# Irrational real numbers

In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
`rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.

We also provide dot-style constructors like `irrational.add_rat`, `irrational.rat_sub` etc.
-/

open Rat Real multiplicity

/-- A real number is irrational if it is not equal to any rational number. -/
def Irrational (x : ℝ) :=
  x ∉ Set.range (coe : ℚ → ℝ)
#align irrational Irrational

theorem irrational_iff_ne_rational (x : ℝ) : Irrational x ↔ ∀ a b : ℤ, x ≠ a / b := by
  simp only [Irrational, Rat.forall, cast_mk, not_exists, Set.mem_range, cast_coe_int, cast_div,
    eq_comm]
#align irrational_iff_ne_rational irrational_iff_ne_rational

/-- A transcendental real number is irrational. -/
theorem Transcendental.irrational {r : ℝ} (tr : Transcendental ℚ r) : Irrational r :=
  by
  rintro ⟨a, rfl⟩
  exact tr (isAlgebraic_algebraMap a)
#align transcendental.irrational Transcendental.irrational

/-!
### Irrationality of roots of integer and rational numbers
-/

/-- If `x^n`, `n > 0`, is integer and is not the `n`-th power of an integer, then
`x` is irrational. -/
theorem irrational_nrt_of_notint_nrt {x : ℝ} (n : ℕ) (m : ℤ) (hxr : x ^ n = m)
    (hv : ¬∃ y : ℤ, x = y) (hnpos : 0 < n) : Irrational x :=
  by
  rintro ⟨⟨N, D, P, C⟩, rfl⟩
  rw [← cast_pow] at hxr
  have c1 : ((D : ℤ) : ℝ) ≠ 0 :=
    by
    rw [Int.cast_ne_zero, Int.coe_nat_ne_zero]
    exact ne_of_gt P
  have c2 : ((D : ℤ) : ℝ) ^ n ≠ 0 := pow_ne_zero _ c1
  rw [num_denom', cast_pow, cast_mk, div_pow, div_eq_iff_mul_eq c2, ← Int.cast_pow, ← Int.cast_pow,
    ← Int.cast_mul, Int.cast_inj] at hxr
  have hdivn : ↑D ^ n ∣ N ^ n := Dvd.intro_left m hxr
  rw [← Int.dvd_natAbs, ← Int.coe_nat_pow, Int.coe_nat_dvd, Int.natAbs_pow,
    Nat.pow_dvd_pow_iff hnpos] at hdivn
  obtain rfl : D = 1 := by rw [← Nat.gcd_eq_right hdivn, C.gcd_eq_one]
  refine' hv ⟨N, _⟩
  rw [num_denom', Int.ofNat_one, mk_eq_div, Int.cast_one, div_one, cast_coe_int]
#align irrational_nrt_of_notint_nrt irrational_nrt_of_notint_nrt

/-- If `x^n = m` is an integer and `n` does not divide the `multiplicity p m`, then `x`
is irrational. -/
theorem irrational_nrt_of_n_not_dvd_multiplicity {x : ℝ} (n : ℕ) {m : ℤ} (hm : m ≠ 0) (p : ℕ)
    [hp : Fact p.Prime] (hxr : x ^ n = m)
    (hv : (multiplicity (p : ℤ) m).get (finite_int_iff.2 ⟨hp.1.ne_one, hm⟩) % n ≠ 0) :
    Irrational x := by
  rcases Nat.eq_zero_or_pos n with (rfl | hnpos)
  · rw [eq_comm, pow_zero, ← Int.cast_one, Int.cast_inj] at hxr
    simpa [hxr,
      multiplicity.one_right (mt isUnit_iff_dvd_one.1 (mt Int.coe_nat_dvd.1 hp.1.not_dvd_one)),
      Nat.zero_mod] using hv
  refine' irrational_nrt_of_notint_nrt _ _ hxr _ hnpos
  rintro ⟨y, rfl⟩
  rw [← Int.cast_pow, Int.cast_inj] at hxr
  subst m
  have : y ≠ 0 := by
    rintro rfl
    rw [zero_pow hnpos] at hm
    exact hm rfl
  erw [multiplicity.pow' (Nat.prime_iff_prime_int.1 hp.1) (finite_int_iff.2 ⟨hp.1.ne_one, this⟩),
    Nat.mul_mod_right] at hv
  exact hv rfl
#align irrational_nrt_of_n_not_dvd_multiplicity irrational_nrt_of_n_not_dvd_multiplicity

theorem irrational_sqrt_of_multiplicity_odd (m : ℤ) (hm : 0 < m) (p : ℕ) [hp : Fact p.Prime]
    (Hpv :
      (multiplicity (p : ℤ) m).get (finite_int_iff.2 ⟨hp.1.ne_one, (ne_of_lt hm).symm⟩) % 2 = 1) :
    Irrational (sqrt m) :=
  @irrational_nrt_of_n_not_dvd_multiplicity _ 2 _ (Ne.symm (ne_of_lt hm)) p hp
    (sq_sqrt (Int.cast_nonneg.2 <| le_of_lt hm)) (by rw [Hpv] <;> exact one_ne_zero)
#align irrational_sqrt_of_multiplicity_odd irrational_sqrt_of_multiplicity_odd

theorem Nat.Prime.irrational_sqrt {p : ℕ} (hp : Nat.Prime p) : Irrational (sqrt p) :=
  @irrational_sqrt_of_multiplicity_odd p (Int.coe_nat_pos.2 hp.Pos) p ⟨hp⟩ <| by
    simp [multiplicity_self (mt isUnit_iff_dvd_one.1 (mt Int.coe_nat_dvd.1 hp.not_dvd_one) : _)] <;>
      rfl
#align nat.prime.irrational_sqrt Nat.Prime.irrational_sqrt

/-- **Irrationality of the Square Root of 2** -/
theorem irrational_sqrt_two : Irrational (sqrt 2) := by simpa using nat.prime_two.irrational_sqrt
#align irrational_sqrt_two irrational_sqrt_two

theorem irrational_sqrt_rat_iff (q : ℚ) :
    Irrational (sqrt q) ↔ Rat.sqrt q * Rat.sqrt q ≠ q ∧ 0 ≤ q :=
  if H1 : Rat.sqrt q * Rat.sqrt q = q then
    iff_of_false
      (not_not_intro
        ⟨Rat.sqrt q, by
          rw [← H1, cast_mul, sqrt_mul_self (cast_nonneg.2 <| Rat.sqrt_nonneg q), sqrt_eq,
            abs_of_nonneg (Rat.sqrt_nonneg q)]⟩)
      fun h => h.1 H1
  else
    if H2 : 0 ≤ q then
      iff_of_true
        (fun ⟨r, hr⟩ =>
          H1 <|
            (exists_mul_self _).1
              ⟨r, by
                rwa [eq_comm, sqrt_eq_iff_mul_self_eq (cast_nonneg.2 H2), ← cast_mul,
                      Rat.cast_inj] at hr <;>
                    rw [← hr] <;>
                  exact Real.sqrt_nonneg _⟩)
        ⟨H1, H2⟩
    else
      iff_of_false
        (not_not_intro
          ⟨0, by
            rw [cast_zero] <;>
              exact (sqrt_eq_zero_of_nonpos (Rat.cast_nonpos.2 <| le_of_not_le H2)).symm⟩)
        fun h => H2 h.2
#align irrational_sqrt_rat_iff irrational_sqrt_rat_iff

instance (q : ℚ) : Decidable (Irrational (sqrt q)) :=
  decidable_of_iff' _ (irrational_sqrt_rat_iff q)

/-!
### Dot-style operations on `irrational`

#### Coercion of a rational/integer/natural number is not irrational
-/

namespace Irrational

variable {x : ℝ}

/-!
#### Irrational number is not equal to a rational/integer/natural number
-/

theorem ne_rat (h : Irrational x) (q : ℚ) : x ≠ q := fun hq => h ⟨q, hq.symm⟩
#align irrational.ne_rat Irrational.ne_rat

theorem ne_int (h : Irrational x) (m : ℤ) : x ≠ m :=
  by
  rw [← Rat.cast_coe_int]
  exact h.ne_rat _
#align irrational.ne_int Irrational.ne_int

theorem ne_nat (h : Irrational x) (m : ℕ) : x ≠ m :=
  h.ne_int m
#align irrational.ne_nat Irrational.ne_nat

theorem ne_zero (h : Irrational x) : x ≠ 0 := by exact_mod_cast h.ne_nat 0
#align irrational.ne_zero Irrational.ne_zero

theorem ne_one (h : Irrational x) : x ≠ 1 := by simpa only [Nat.cast_one] using h.ne_nat 1
#align irrational.ne_one Irrational.ne_one

end Irrational

@[simp]
theorem Rat.not_irrational (q : ℚ) : ¬Irrational q := fun h => h ⟨q, rfl⟩
#align rat.not_irrational Rat.not_irrational

@[simp]
theorem Int.not_irrational (m : ℤ) : ¬Irrational m := fun h => h.ne_int m rfl
#align int.not_irrational Int.not_irrational

@[simp]
theorem Nat.not_irrational (m : ℕ) : ¬Irrational m := fun h => h.ne_nat m rfl
#align nat.not_irrational Nat.not_irrational

namespace Irrational

variable (q : ℚ) {x y : ℝ}

/-!
#### Addition of rational/integer/natural numbers
-/

/-- If `x + y` is irrational, then at least one of `x` and `y` is irrational. -/
theorem add_cases : Irrational (x + y) → Irrational x ∨ Irrational y :=
  by
  delta Irrational
  contrapose!
  rintro ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩
  exact ⟨rx + ry, cast_add rx ry⟩
#align irrational.add_cases Irrational.add_cases

theorem of_rat_add (h : Irrational (q + x)) : Irrational x :=
  h.addCases.resolve_left q.not_irrational
#align irrational.of_rat_add Irrational.of_rat_add

theorem rat_add (h : Irrational x) : Irrational (q + x) :=
  of_rat_add (-q) <| by rwa [cast_neg, neg_add_cancel_left]
#align irrational.rat_add Irrational.rat_add

theorem of_add_rat : Irrational (x + q) → Irrational x :=
  add_comm (↑q) x ▸ of_rat_add q
#align irrational.of_add_rat Irrational.of_add_rat

theorem add_rat (h : Irrational x) : Irrational (x + q) :=
  add_comm (↑q) x ▸ h.rat_add q
#align irrational.add_rat Irrational.add_rat

theorem of_int_add (m : ℤ) (h : Irrational (m + x)) : Irrational x :=
  by
  rw [← cast_coe_int] at h
  exact h.of_rat_add m
#align irrational.of_int_add Irrational.of_int_add

theorem of_add_int (m : ℤ) (h : Irrational (x + m)) : Irrational x :=
  of_int_add m <| add_comm x m ▸ h
#align irrational.of_add_int Irrational.of_add_int

theorem int_add (h : Irrational x) (m : ℤ) : Irrational (m + x) :=
  by
  rw [← cast_coe_int]
  exact h.rat_add m
#align irrational.int_add Irrational.int_add

theorem add_int (h : Irrational x) (m : ℤ) : Irrational (x + m) :=
  add_comm (↑m) x ▸ h.int_add m
#align irrational.add_int Irrational.add_int

theorem of_nat_add (m : ℕ) (h : Irrational (m + x)) : Irrational x :=
  h.of_int_add m
#align irrational.of_nat_add Irrational.of_nat_add

theorem of_add_nat (m : ℕ) (h : Irrational (x + m)) : Irrational x :=
  h.of_add_int m
#align irrational.of_add_nat Irrational.of_add_nat

theorem nat_add (h : Irrational x) (m : ℕ) : Irrational (m + x) :=
  h.int_add m
#align irrational.nat_add Irrational.nat_add

theorem add_nat (h : Irrational x) (m : ℕ) : Irrational (x + m) :=
  h.add_int m
#align irrational.add_nat Irrational.add_nat

/-!
#### Negation
-/

theorem of_neg (h : Irrational (-x)) : Irrational x := fun ⟨q, hx⟩ => h ⟨-q, by rw [cast_neg, hx]⟩
#align irrational.of_neg Irrational.of_neg

protected theorem neg (h : Irrational x) : Irrational (-x) :=
  of_neg <| by rwa [neg_neg]
#align irrational.neg Irrational.neg

/-!
#### Subtraction of rational/integer/natural numbers
-/

theorem sub_rat (h : Irrational x) : Irrational (x - q) := by
  simpa only [sub_eq_add_neg, cast_neg] using h.add_rat (-q)
#align irrational.sub_rat Irrational.sub_rat

theorem rat_sub (h : Irrational x) : Irrational (q - x) := by
  simpa only [sub_eq_add_neg] using h.neg.rat_add q
#align irrational.rat_sub Irrational.rat_sub

theorem of_sub_rat (h : Irrational (x - q)) : Irrational x :=
  of_add_rat (-q) <| by simpa only [cast_neg, sub_eq_add_neg] using h
#align irrational.of_sub_rat Irrational.of_sub_rat

theorem of_rat_sub (h : Irrational (q - x)) : Irrational x :=
  of_neg (of_rat_add q (by simpa only [sub_eq_add_neg] using h))
#align irrational.of_rat_sub Irrational.of_rat_sub

theorem sub_int (h : Irrational x) (m : ℤ) : Irrational (x - m) := by
  simpa only [Rat.cast_coe_int] using h.sub_rat m
#align irrational.sub_int Irrational.sub_int

theorem int_sub (h : Irrational x) (m : ℤ) : Irrational (m - x) := by
  simpa only [Rat.cast_coe_int] using h.rat_sub m
#align irrational.int_sub Irrational.int_sub

theorem of_sub_int (m : ℤ) (h : Irrational (x - m)) : Irrational x :=
  of_sub_rat m <| by rwa [Rat.cast_coe_int]
#align irrational.of_sub_int Irrational.of_sub_int

theorem of_int_sub (m : ℤ) (h : Irrational (m - x)) : Irrational x :=
  of_rat_sub m <| by rwa [Rat.cast_coe_int]
#align irrational.of_int_sub Irrational.of_int_sub

theorem sub_nat (h : Irrational x) (m : ℕ) : Irrational (x - m) :=
  h.sub_int m
#align irrational.sub_nat Irrational.sub_nat

theorem nat_sub (h : Irrational x) (m : ℕ) : Irrational (m - x) :=
  h.int_sub m
#align irrational.nat_sub Irrational.nat_sub

theorem of_sub_nat (m : ℕ) (h : Irrational (x - m)) : Irrational x :=
  h.of_sub_int m
#align irrational.of_sub_nat Irrational.of_sub_nat

theorem of_nat_sub (m : ℕ) (h : Irrational (m - x)) : Irrational x :=
  h.of_int_sub m
#align irrational.of_nat_sub Irrational.of_nat_sub

/-!
#### Multiplication by rational numbers
-/

theorem mul_cases : Irrational (x * y) → Irrational x ∨ Irrational y :=
  by
  delta Irrational
  contrapose!
  rintro ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩
  exact ⟨rx * ry, cast_mul rx ry⟩
#align irrational.mul_cases Irrational.mul_cases

theorem of_mul_rat (h : Irrational (x * q)) : Irrational x :=
  h.mul_cases.resolve_right q.not_irrational
#align irrational.of_mul_rat Irrational.of_mul_rat

theorem mul_rat (h : Irrational x) {q : ℚ} (hq : q ≠ 0) : Irrational (x * q) :=
  of_mul_rat q⁻¹ <| by rwa [mul_assoc, ← cast_mul, mul_inv_cancel hq, cast_one, mul_one]
#align irrational.mul_rat Irrational.mul_rat

theorem of_rat_mul : Irrational (q * x) → Irrational x :=
  mul_comm x q ▸ of_mul_rat q
#align irrational.of_rat_mul Irrational.of_rat_mul

theorem rat_mul (h : Irrational x) {q : ℚ} (hq : q ≠ 0) : Irrational (q * x) :=
  mul_comm x q ▸ h.mul_rat hq
#align irrational.rat_mul Irrational.rat_mul

theorem of_mul_int (m : ℤ) (h : Irrational (x * m)) : Irrational x :=
  of_mul_rat m <| by rwa [cast_coe_int]
#align irrational.of_mul_int Irrational.of_mul_int

theorem of_int_mul (m : ℤ) (h : Irrational (m * x)) : Irrational x :=
  of_rat_mul m <| by rwa [cast_coe_int]
#align irrational.of_int_mul Irrational.of_int_mul

theorem mul_int (h : Irrational x) {m : ℤ} (hm : m ≠ 0) : Irrational (x * m) :=
  by
  rw [← cast_coe_int]
  refine' h.mul_rat _
  rwa [Int.cast_ne_zero]
#align irrational.mul_int Irrational.mul_int

theorem int_mul (h : Irrational x) {m : ℤ} (hm : m ≠ 0) : Irrational (m * x) :=
  mul_comm x m ▸ h.mul_int hm
#align irrational.int_mul Irrational.int_mul

theorem of_mul_nat (m : ℕ) (h : Irrational (x * m)) : Irrational x :=
  h.of_mul_int m
#align irrational.of_mul_nat Irrational.of_mul_nat

theorem of_nat_mul (m : ℕ) (h : Irrational (m * x)) : Irrational x :=
  h.of_int_mul m
#align irrational.of_nat_mul Irrational.of_nat_mul

theorem mul_nat (h : Irrational x) {m : ℕ} (hm : m ≠ 0) : Irrational (x * m) :=
  h.mul_int <| Int.coe_nat_ne_zero.2 hm
#align irrational.mul_nat Irrational.mul_nat

theorem nat_mul (h : Irrational x) {m : ℕ} (hm : m ≠ 0) : Irrational (m * x) :=
  h.int_mul <| Int.coe_nat_ne_zero.2 hm
#align irrational.nat_mul Irrational.nat_mul

/-!
#### Inverse
-/

theorem of_inv (h : Irrational x⁻¹) : Irrational x := fun ⟨q, hq⟩ => h <| hq ▸ ⟨q⁻¹, q.cast_inv⟩
#align irrational.of_inv Irrational.of_inv

protected theorem inv (h : Irrational x) : Irrational x⁻¹ :=
  of_inv <| by rwa [inv_inv]
#align irrational.inv Irrational.inv

/-!
#### Division
-/

theorem div_cases (h : Irrational (x / y)) : Irrational x ∨ Irrational y :=
  h.mul_cases.imp id of_inv
#align irrational.div_cases Irrational.div_cases

theorem of_rat_div (h : Irrational (q / x)) : Irrational x :=
  (h.ofRat_mul q).of_inv
#align irrational.of_rat_div Irrational.of_rat_div

theorem of_div_rat (h : Irrational (x / q)) : Irrational x :=
  h.div_cases.resolve_right q.not_irrational
#align irrational.of_div_rat Irrational.of_div_rat

theorem rat_div (h : Irrational x) {q : ℚ} (hq : q ≠ 0) : Irrational (q / x) :=
  h.inv.rat_mul hq
#align irrational.rat_div Irrational.rat_div

theorem div_rat (h : Irrational x) {q : ℚ} (hq : q ≠ 0) : Irrational (x / q) :=
  by
  rw [div_eq_mul_inv, ← cast_inv]
  exact h.mul_rat (inv_ne_zero hq)
#align irrational.div_rat Irrational.div_rat

theorem of_int_div (m : ℤ) (h : Irrational (m / x)) : Irrational x :=
  h.div_cases.resolve_left m.not_irrational
#align irrational.of_int_div Irrational.of_int_div

theorem of_div_int (m : ℤ) (h : Irrational (x / m)) : Irrational x :=
  h.div_cases.resolve_right m.not_irrational
#align irrational.of_div_int Irrational.of_div_int

theorem int_div (h : Irrational x) {m : ℤ} (hm : m ≠ 0) : Irrational (m / x) :=
  h.inv.int_mul hm
#align irrational.int_div Irrational.int_div

theorem div_int (h : Irrational x) {m : ℤ} (hm : m ≠ 0) : Irrational (x / m) :=
  by
  rw [← cast_coe_int]
  refine' h.div_rat _
  rwa [Int.cast_ne_zero]
#align irrational.div_int Irrational.div_int

theorem of_nat_div (m : ℕ) (h : Irrational (m / x)) : Irrational x :=
  h.of_int_div m
#align irrational.of_nat_div Irrational.of_nat_div

theorem of_div_nat (m : ℕ) (h : Irrational (x / m)) : Irrational x :=
  h.of_div_int m
#align irrational.of_div_nat Irrational.of_div_nat

theorem nat_div (h : Irrational x) {m : ℕ} (hm : m ≠ 0) : Irrational (m / x) :=
  h.inv.nat_mul hm
#align irrational.nat_div Irrational.nat_div

theorem div_nat (h : Irrational x) {m : ℕ} (hm : m ≠ 0) : Irrational (x / m) :=
  h.div_int <| by rwa [Int.coe_nat_ne_zero]
#align irrational.div_nat Irrational.div_nat

theorem of_one_div (h : Irrational (1 / x)) : Irrational x :=
  of_rat_div 1 <| by rwa [cast_one]
#align irrational.of_one_div Irrational.of_one_div

/-!
#### Natural and integerl power
-/

theorem of_mul_self (h : Irrational (x * x)) : Irrational x :=
  h.mul_cases.elim id id
#align irrational.of_mul_self Irrational.of_mul_self

theorem of_pow : ∀ n : ℕ, Irrational (x ^ n) → Irrational x
  | 0 => fun h => by
    rw [pow_zero] at h
    exact (h ⟨1, cast_one⟩).elim
  | n + 1 => fun h => by
    rw [pow_succ] at h
    exact h.mul_cases.elim id (of_pow n)
#align irrational.of_pow Irrational.of_pow

theorem of_zpow : ∀ m : ℤ, Irrational (x ^ m) → Irrational x
  | (n : ℕ) => fun h => by
    rw [zpow_ofNat] at h
    exact h.of_pow _
  | -[n+1] => fun h => by
    rw [zpow_negSucc] at h
    exact h.of_inv.of_pow _
#align irrational.of_zpow Irrational.of_zpow

end Irrational

section Polynomial

open Polynomial

open Polynomial

variable (x : ℝ) (p : ℤ[X])

theorem one_lt_natDegree_of_irrational_root (hx : Irrational x) (p_nonzero : p ≠ 0)
    (x_is_root : aeval x p = 0) : 1 < p.natDegree :=
  by
  by_contra rid
  rcases exists_eq_X_add_C_of_nat_degree_le_one (not_lt.1 rid) with ⟨a, b, rfl⟩
  clear rid
  have : (a : ℝ) * x = -b := by simpa [eq_neg_iff_add_eq_zero] using x_is_root
  rcases em (a = 0) with (rfl | ha)
  · obtain rfl : b = 0 := by simpa
    simpa using p_nonzero
  · rw [mul_comm, ← eq_div_iff_mul_eq, eq_comm] at this
    refine' hx ⟨-b / a, _⟩
    assumption_mod_cast
    assumption_mod_cast
#align one_lt_nat_degree_of_irrational_root one_lt_natDegree_of_irrational_root

end Polynomial

section

variable {q : ℚ} {m : ℤ} {n : ℕ} {x : ℝ}

open Irrational

/-!
### Simplification lemmas about operations
-/

@[simp]
theorem irrational_rat_add_iff : Irrational (q + x) ↔ Irrational x :=
  ⟨of_rat_add q, rat_add q⟩
#align irrational_rat_add_iff irrational_rat_add_iff

@[simp]
theorem irrational_int_add_iff : Irrational (m + x) ↔ Irrational x :=
  ⟨of_int_add m, fun h => h.int_add m⟩
#align irrational_int_add_iff irrational_int_add_iff

@[simp]
theorem irrational_nat_add_iff : Irrational (n + x) ↔ Irrational x :=
  ⟨of_nat_add n, fun h => h.natAdd n⟩
#align irrational_nat_add_iff irrational_nat_add_iff

@[simp]
theorem irrational_add_rat_iff : Irrational (x + q) ↔ Irrational x :=
  ⟨of_add_rat q, add_rat q⟩
#align irrational_add_rat_iff irrational_add_rat_iff

@[simp]
theorem irrational_add_int_iff : Irrational (x + m) ↔ Irrational x :=
  ⟨of_add_int m, fun h => h.add_int m⟩
#align irrational_add_int_iff irrational_add_int_iff

@[simp]
theorem irrational_add_nat_iff : Irrational (x + n) ↔ Irrational x :=
  ⟨of_add_nat n, fun h => h.addNat n⟩
#align irrational_add_nat_iff irrational_add_nat_iff

@[simp]
theorem irrational_rat_sub_iff : Irrational (q - x) ↔ Irrational x :=
  ⟨of_rat_sub q, rat_sub q⟩
#align irrational_rat_sub_iff irrational_rat_sub_iff

@[simp]
theorem irrational_int_sub_iff : Irrational (m - x) ↔ Irrational x :=
  ⟨of_int_sub m, fun h => h.int_sub m⟩
#align irrational_int_sub_iff irrational_int_sub_iff

@[simp]
theorem irrational_nat_sub_iff : Irrational (n - x) ↔ Irrational x :=
  ⟨of_nat_sub n, fun h => h.nat_sub n⟩
#align irrational_nat_sub_iff irrational_nat_sub_iff

@[simp]
theorem irrational_sub_rat_iff : Irrational (x - q) ↔ Irrational x :=
  ⟨of_sub_rat q, sub_rat q⟩
#align irrational_sub_rat_iff irrational_sub_rat_iff

@[simp]
theorem irrational_sub_int_iff : Irrational (x - m) ↔ Irrational x :=
  ⟨of_sub_int m, fun h => h.sub_int m⟩
#align irrational_sub_int_iff irrational_sub_int_iff

@[simp]
theorem irrational_sub_nat_iff : Irrational (x - n) ↔ Irrational x :=
  ⟨of_sub_nat n, fun h => h.subNat n⟩
#align irrational_sub_nat_iff irrational_sub_nat_iff

@[simp]
theorem irrational_neg_iff : Irrational (-x) ↔ Irrational x :=
  ⟨of_neg, Irrational.neg⟩
#align irrational_neg_iff irrational_neg_iff

@[simp]
theorem irrational_inv_iff : Irrational x⁻¹ ↔ Irrational x :=
  ⟨of_inv, Irrational.inv⟩
#align irrational_inv_iff irrational_inv_iff

@[simp]
theorem irrational_rat_mul_iff : Irrational (q * x) ↔ q ≠ 0 ∧ Irrational x :=
  ⟨fun h => ⟨Rat.cast_ne_zero.1 <| left_ne_zero_of_mul h.NeZero, h.ofRat_mul q⟩, fun h =>
    h.2.rat_mul h.1⟩
#align irrational_rat_mul_iff irrational_rat_mul_iff

@[simp]
theorem irrational_mul_rat_iff : Irrational (x * q) ↔ q ≠ 0 ∧ Irrational x := by
  rw [mul_comm, irrational_rat_mul_iff]
#align irrational_mul_rat_iff irrational_mul_rat_iff

@[simp]
theorem irrational_int_mul_iff : Irrational (m * x) ↔ m ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_int, irrational_rat_mul_iff, Int.cast_ne_zero]
#align irrational_int_mul_iff irrational_int_mul_iff

@[simp]
theorem irrational_mul_int_iff : Irrational (x * m) ↔ m ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_int, irrational_mul_rat_iff, Int.cast_ne_zero]
#align irrational_mul_int_iff irrational_mul_int_iff

@[simp]
theorem irrational_nat_mul_iff : Irrational (n * x) ↔ n ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_nat, irrational_rat_mul_iff, Nat.cast_ne_zero]
#align irrational_nat_mul_iff irrational_nat_mul_iff

@[simp]
theorem irrational_mul_nat_iff : Irrational (x * n) ↔ n ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_nat, irrational_mul_rat_iff, Nat.cast_ne_zero]
#align irrational_mul_nat_iff irrational_mul_nat_iff

@[simp]
theorem irrational_rat_div_iff : Irrational (q / x) ↔ q ≠ 0 ∧ Irrational x := by
  simp [div_eq_mul_inv]
#align irrational_rat_div_iff irrational_rat_div_iff

@[simp]
theorem irrational_div_rat_iff : Irrational (x / q) ↔ q ≠ 0 ∧ Irrational x := by
  rw [div_eq_mul_inv, ← cast_inv, irrational_mul_rat_iff, Ne.def, inv_eq_zero]
#align irrational_div_rat_iff irrational_div_rat_iff

@[simp]
theorem irrational_int_div_iff : Irrational (m / x) ↔ m ≠ 0 ∧ Irrational x := by
  simp [div_eq_mul_inv]
#align irrational_int_div_iff irrational_int_div_iff

@[simp]
theorem irrational_div_int_iff : Irrational (x / m) ↔ m ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_int, irrational_div_rat_iff, Int.cast_ne_zero]
#align irrational_div_int_iff irrational_div_int_iff

@[simp]
theorem irrational_nat_div_iff : Irrational (n / x) ↔ n ≠ 0 ∧ Irrational x := by
  simp [div_eq_mul_inv]
#align irrational_nat_div_iff irrational_nat_div_iff

@[simp]
theorem irrational_div_nat_iff : Irrational (x / n) ↔ n ≠ 0 ∧ Irrational x := by
  rw [← cast_coe_nat, irrational_div_rat_iff, Nat.cast_ne_zero]
#align irrational_div_nat_iff irrational_div_nat_iff

/-- There is an irrational number `r` between any two reals `x < r < y`. -/
theorem exists_irrational_btwn {x y : ℝ} (h : x < y) : ∃ r, Irrational r ∧ x < r ∧ r < y :=
  let ⟨q, ⟨hq1, hq2⟩⟩ := exists_rat_btwn ((sub_lt_sub_iff_right (Real.sqrt 2)).mpr h)
  ⟨q + Real.sqrt 2, irrational_sqrt_two.rat_add _, sub_lt_iff_lt_add.mp hq1,
    lt_sub_iff_add_lt.mp hq2⟩
#align exists_irrational_btwn exists_irrational_btwn

end


import tactic.basic
-- Use the standard construction for the rationals for convenience.
import data.rat

-- For now, we just define Cauchy sequences on the rationals.
-- Once we construct the reals, we can use them to make metric spaces.
def is_real_cauchy_seq (u : ℕ → ℚ) : Prop :=
∀ ε > 0, ∃ N : ℕ, ∀ m n ≥ N, |u m - u n| < ε

abbreviation real_cauchy_seq := {u : ℕ → ℚ // is_real_cauchy_seq u}

namespace real_cauchy_seq

abbreviation rcs := real_cauchy_seq

def add (u v : rcs) : rcs := ⟨
  λ n, u.1 n + v.1 n,
  begin
    intros ε hε,
    have : ε/2 > 0 := by linarith,
    obtain ⟨M, hM⟩ := u.2 (ε/2) this,
    obtain ⟨N, hN⟩ := v.2 (ε/2) this,
    refine ⟨(max M N), _⟩,
    intros m hm n hn,
    have := le_max_left M N,
    have := le_max_right M N,
    specialize hM m (by linarith) n (by linarith),
    specialize hN n (by linarith) m (by linarith),
    dsimp at *,
    have : ε = ε / 2 + ε / 2 := by ring,
    rw this,
    rw abs_lt at *,
    obtain ⟨hM₁, hM₂⟩ := hM,
    obtain ⟨hN₁, hN₂⟩ := hN,
    split; linarith
  end
⟩

def converges_to_zero (u : real_cauchy_seq) : Prop :=
∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, |u.1 n| < ε

-- r is satisfied if the difference between the two Cauchy sequences converges to zero.
def r (u v : real_cauchy_seq) : Prop := sorry

lemma r_refl : reflexive r := sorry

lemma r_symm : symmetric r := sorry

lemma r_trans : transitive r := sorry

instance setoid : setoid real_cauchy_seq := ⟨r, r_refl, r_symm, r_trans⟩

end real_cauchy_seq