/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, E. W. Ayers
-/

import order.complete_lattice
import category_theory.over
import category_theory.yoneda
import category_theory.limits.shapes.pullbacks
import data.set.lattice

/-!
# Theory of sieves

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

- For an object `X` of a category `C`, a `sieve X` is a set of morphisms to `X`
  which is closed under left-composition.
- The complete lattice structure on sieves is given, as well as the Galois insertion
  given by downward-closing.
- A `sieve X` (functorially) induces a presheaf on `C` together with a monomorphism to
  the yoneda embedding of `X`.

## Tags

sieve, pullback
-/

universes v₁ v₂ v₃ u₁ u₂ u₃
namespace category_theory

open category limits

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (F : C ⥤ D)
variables {X Y Z : C} (f : Y ⟶ X)

/-- A set of arrows all with codomain `X`. -/
@[derive complete_lattice]
def presieve (X : C) := Π ⦃Y⦄, set (Y ⟶ X)

namespace presieve

instance : inhabited (presieve X) := ⟨⊤⟩

/-- Given a sieve `S` on `X : C`, its associated diagram `S.diagram` is defined to be
    the natural functor from the full subcategory of the over category `C/X` consisting
    of arrows in `S` to `C`. -/
abbreviation diagram (S : presieve X) : full_subcategory (λ (f : over X), S f.hom) ⥤ C :=
full_subcategory_inclusion _ ⋙ over.forget X

/-- Given a sieve `S` on `X : C`, its associated cocone `S.cocone` is defined to be
    the natural cocone over the diagram defined above with cocone point `X`. -/
abbreviation cocone (S : presieve X) : cocone S.diagram :=
(over.forget_cocone X).whisker (full_subcategory_inclusion _)

/--
Given a set of arrows `S` all with codomain `X`, and a set of arrows with codomain `Y` for each
`f : Y ⟶ X` in `S`, produce a set of arrows with codomain `X`:
`{ g ≫ f | (f : Y ⟶ X) ∈ S, (g : Z ⟶ Y) ∈ R f }`.
-/
def bind (S : presieve X) (R : Π ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → presieve Y) :
  presieve X :=
λ Z h, ∃ (Y : C) (g : Z ⟶ Y) (f : Y ⟶ X) (H : S f), R H g ∧ g ≫ f = h

@[simp]
lemma bind_comp {S : presieve X}
  {R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → presieve Y} {g : Z ⟶ Y} (h₁ : S f) (h₂ : R h₁ g) :
bind S R (g ≫ f) :=
⟨_, _, _, h₁, h₂, rfl⟩

/-- The singleton presieve.  -/
-- Note we can't make this into `has_singleton` because of the out-param.
inductive singleton : presieve X
| mk : singleton f

@[simp] lemma singleton_eq_iff_domain (f g : Y ⟶ X) : singleton f g ↔ f = g :=
begin
  split,
  { rintro ⟨a, rfl⟩,
    refl },
  { rintro rfl,
    apply singleton.mk, }
end

lemma singleton_self : singleton f f := singleton.mk

/--
Pullback a set of arrows with given codomain along a fixed map, by taking the pullback in the
category.
This is not the same as the arrow set of `sieve.pullback`, but there is a relation between them
in `pullback_arrows_comm`.
-/
inductive pullback_arrows [has_pullbacks C] (R : presieve X) :
  presieve Y
| mk (Z : C) (h : Z ⟶ X) : R h → pullback_arrows (pullback.snd : pullback h f ⟶ Y)

lemma pullback_singleton [has_pullbacks C] (g : Z ⟶ X) :
 pullback_arrows f (singleton g) = singleton (pullback.snd : pullback g f ⟶ _) :=
begin
  ext W h,
  split,
  { rintro ⟨W, _, _, _⟩,
    exact singleton.mk },
  { rintro ⟨_⟩,
    exact pullback_arrows.mk Z g singleton.mk }
end

/-- Construct the presieve given by the family of arrows indexed by `ι`. -/
inductive of_arrows {ι : Type*} (Y : ι → C) (f : Π i, Y i ⟶ X) : presieve X
| mk (i : ι) : of_arrows (f i)

lemma of_arrows_punit :
  of_arrows _ (λ _ : punit, f) = singleton f :=
begin
  ext Y g,
  split,
  { rintro ⟨_⟩,
    apply singleton.mk },
  { rintro ⟨_⟩,
    exact of_arrows.mk punit.star },
end

lemma of_arrows_pullback [has_pullbacks C] {ι : Type*}
  (Z : ι → C) (g : Π (i : ι), Z i ⟶ X) :
  of_arrows (λ i, pullback (g i) f) (λ i, pullback.snd) =
    pullback_arrows f (of_arrows Z g) :=
begin
  ext T h,
  split,
  { rintro ⟨hk⟩,
   exact pullback_arrows.mk _ _ (of_arrows.mk hk) },
  { rintro ⟨W, k, hk₁⟩,
    cases hk₁ with i hi,
    apply of_arrows.mk },
end

lemma of_arrows_bind {ι : Type*} (Z : ι → C) (g : Π (i : ι), Z i ⟶ X)
  (j : Π ⦃Y⦄ (f : Y ⟶ X), of_arrows Z g f → Type*)
  (W : Π ⦃Y⦄ (f : Y ⟶ X) H, j f H → C)
  (k : Π ⦃Y⦄ (f : Y ⟶ X) H i, W f H i ⟶ Y) :
  (of_arrows Z g).bind (λ Y f H, of_arrows (W f H) (k f H)) =
    of_arrows (λ (i : Σ i, j _ (of_arrows.mk i)), W (g i.1) _ i.2)
      (λ ij, k (g ij.1) _ ij.2 ≫ g ij.1) :=
begin
  ext Y f,
  split,
  { rintro ⟨_, _, _, ⟨i⟩, ⟨i'⟩, rfl⟩,
    exact of_arrows.mk (sigma.mk _ _) },
  { rintro ⟨i⟩,
    exact bind_comp _ (of_arrows.mk _) (of_arrows.mk _) }
end

/-- Given a presieve on `F(X)`, we can define a presieve on `X` by taking the preimage via `F`. -/
def functor_pullback (R : presieve (F.obj X)) : presieve X := λ _ f, R (F.map f)

@[simp] lemma functor_pullback_mem (R : presieve (F.obj X)) {Y} (f : Y ⟶ X) :
  R.functor_pullback F f ↔ R (F.map f) := iff.rfl

@[simp] lemma functor_pullback_id (R : presieve X) : R.functor_pullback (𝟭 _) = R := rfl

section functor_pushforward
variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E)

/--
Given a presieve on `X`, we can define a presieve on `F(X)` (which is actually a sieve)
by taking the sieve generated by the image via `F`.
-/
def functor_pushforward (S : presieve X) : presieve (F.obj X) :=
λ Y f, ∃ (Z : C) (g : Z ⟶ X) (h : Y ⟶ F.obj Z), S g ∧ f = h ≫ F.map g

/--
An auxillary definition in order to fix the choice of the preimages between various definitions.
-/
@[nolint has_nonempty_instance]
structure functor_pushforward_structure (S : presieve X) {Y} (f : Y ⟶ F.obj X) :=
(preobj : C) (premap : preobj ⟶ X) (lift : Y ⟶ F.obj preobj)
(cover : S premap) (fac : f = lift ≫ F.map premap)

/-- The fixed choice of a preimage. -/
noncomputable def get_functor_pushforward_structure {F : C ⥤ D} {S : presieve X} {Y : D}
  {f : Y ⟶ F.obj X} (h : S.functor_pushforward F f) : functor_pushforward_structure F S f :=
by { choose Z f' g h₁ h using h, exact ⟨Z, f', g, h₁, h⟩ }

lemma functor_pushforward_comp (R : presieve X) :
  R.functor_pushforward (F ⋙ G) = (R.functor_pushforward F).functor_pushforward G :=
begin
  ext x f,
  split,
  { rintro ⟨X, f₁, g₁, h₁, rfl⟩, exact ⟨F.obj X, F.map f₁, g₁, ⟨X, f₁, 𝟙 _, h₁, by simp⟩, rfl⟩ },
  { rintro ⟨X, f₁, g₁, ⟨X', f₂, g₂, h₁, rfl⟩, rfl⟩, use ⟨X', f₂, g₁ ≫ G.map g₂, h₁, by simp⟩ }
end

lemma image_mem_functor_pushforward (R : presieve X) {f : Y ⟶ X} (h : R f) :
  R.functor_pushforward F (F.map f) := ⟨Y, f, 𝟙 _, h, by simp⟩

end functor_pushforward
end presieve

/--
For an object `X` of a category `C`, a `sieve X` is a set of morphisms to `X` which is closed under
left-composition.
-/
structure sieve {C : Type u₁} [category.{v₁} C] (X : C) :=
(arrows : presieve X)
(downward_closed' : ∀ {Y Z f} (hf : arrows f) (g : Z ⟶ Y), arrows (g ≫ f))

namespace sieve

instance : has_coe_to_fun (sieve X) (λ _, presieve X) := ⟨sieve.arrows⟩

initialize_simps_projections sieve (arrows → apply)

variables {S R : sieve X}

@[simp, priority 100] lemma downward_closed (S : sieve X) {f : Y ⟶ X} (hf : S f)
  (g : Z ⟶ Y) : S (g ≫ f) :=
S.downward_closed' hf g

lemma arrows_ext : Π {R S : sieve X}, R.arrows = S.arrows → R = S
| ⟨Ra, _⟩ ⟨Sa, _⟩ rfl := rfl

@[ext]
protected lemma ext {R S : sieve X}
  (h : ∀ ⦃Y⦄ (f : Y ⟶ X), R f ↔ S f) :
  R = S :=
arrows_ext $ funext $ λ x, funext $ λ f, propext $ h f

protected lemma ext_iff {R S : sieve X} :
  R = S ↔ (∀ ⦃Y⦄ (f : Y ⟶ X), R f ↔ S f) :=
⟨λ h Y f, h ▸ iff.rfl, sieve.ext⟩

open lattice

/-- The supremum of a collection of sieves: the union of them all. -/
protected def Sup (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := λ Y, {f | ∃ S ∈ 𝒮, sieve.arrows S f},
  downward_closed' := λ Y Z f, by { rintro ⟨S, hS, hf⟩ g, exact ⟨S, hS, S.downward_closed hf _⟩ } }

/-- The infimum of a collection of sieves: the intersection of them all. -/
protected def Inf (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := λ Y, {f | ∀ S ∈ 𝒮, sieve.arrows S f},
  downward_closed' := λ Y Z f hf g S H, S.downward_closed (hf S H) g }

/-- The union of two sieves is a sieve. -/
protected def union (S R : sieve X) : sieve X :=
{ arrows := λ Y f, S f ∨ R f,
  downward_closed' := by { rintros Y Z f (h | h) g; simp [h] } }

/-- The intersection of two sieves is a sieve. -/
protected def inter (S R : sieve X) : sieve X :=
{ arrows := λ Y f, S f ∧ R f,
  downward_closed' := by { rintros Y Z f ⟨h₁, h₂⟩ g, simp [h₁, h₂] } }

/--
Sieves on an object `X` form a complete lattice.
We generate this directly rather than using the galois insertion for nicer definitional properties.
-/
instance : complete_lattice (sieve X) :=
{ le           := λ S R, ∀ ⦃Y⦄ (f : Y ⟶ X), S f → R f,
  le_refl      := λ S f q, id,
  le_trans     := λ S₁ S₂ S₃ S₁₂ S₂₃ Y f h, S₂₃ _ (S₁₂ _ h),
  le_antisymm  := λ S R p q, sieve.ext (λ Y f, ⟨p _, q _⟩),
  top          := { arrows := λ _, set.univ, downward_closed' := λ Y Z f g h, ⟨⟩ },
  bot          := { arrows := λ _, ∅, downward_closed' := λ _ _ _ p _, false.elim p },
  sup          := sieve.union,
  inf          := sieve.inter,
  Sup          := sieve.Sup,
  Inf          := sieve.Inf,
  le_Sup       := λ 𝒮 S hS Y f hf, ⟨S, hS, hf⟩,
  Sup_le       := λ ℰ S hS Y f, by { rintro ⟨R, hR, hf⟩, apply hS R hR _ hf },
  Inf_le       := λ _ _ hS _ _ h, h _ hS,
  le_Inf       := λ _ _ hS _ _ hf _ hR, hS _ hR _ hf,
  le_sup_left  := λ _ _ _ _, or.inl,
  le_sup_right := λ _ _ _ _, or.inr,
  sup_le       := λ _ _ _ a b _ _ hf, hf.elim (a _) (b _),
  inf_le_left  := λ _ _ _ _, and.left,
  inf_le_right := λ _ _ _ _, and.right,
  le_inf       := λ _ _ _ p q _ _ z, ⟨p _ z, q _ z⟩,
  le_top       := λ _ _ _ _, trivial,
  bot_le       := λ _ _ _, false.elim }

/-- The maximal sieve always exists. -/
instance sieve_inhabited : inhabited (sieve X) := ⟨⊤⟩

@[simp]
lemma Inf_apply {Ss : set (sieve X)} {Y} (f : Y ⟶ X) :
  Inf Ss f ↔ ∀ (S : sieve X) (H : S ∈ Ss), S f :=
iff.rfl

@[simp]
lemma Sup_apply {Ss : set (sieve X)} {Y} (f : Y ⟶ X) :
  Sup Ss f ↔ ∃ (S : sieve X) (H : S ∈ Ss), S f :=
iff.rfl

@[simp]
lemma inter_apply {R S : sieve X} {Y} (f : Y ⟶ X) :
  (R ⊓ S) f ↔ R f ∧ S f :=
iff.rfl

@[simp]
lemma union_apply {R S : sieve X} {Y} (f : Y ⟶ X) :
  (R ⊔ S) f ↔ R f ∨ S f :=
iff.rfl

@[simp]
lemma top_apply (f : Y ⟶ X) : (⊤ : sieve X) f := trivial

/-- Generate the smallest sieve containing the given set of arrows. -/
@[simps]
def generate (R : presieve X) : sieve X :=
{ arrows := λ Z f, ∃ Y (h : Z ⟶ Y) (g : Y ⟶ X), R g ∧ h ≫ g = f,
  downward_closed' :=
  begin
    rintro Y Z _ ⟨W, g, f, hf, rfl⟩ h,
    exact ⟨_, h ≫ g, _, hf, by simp⟩,
  end }

/--
Given a presieve on `X`, and a sieve on each domain of an arrow in the presieve, we can bind to
produce a sieve on `X`.
-/
@[simps]
def bind (S : presieve X) (R : Π ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y) : sieve X :=
{ arrows := S.bind (λ Y f h, R h),
  downward_closed' :=
  begin
    rintro Y Z f ⟨W, f, h, hh, hf, rfl⟩ g,
    exact ⟨_, g ≫ f, _, hh, by simp [hf]⟩,
  end }

open order lattice

lemma sets_iff_generate (R : presieve X) (S : sieve X) :
  generate R ≤ S ↔ R ≤ S :=
⟨λ H Y g hg, H _ ⟨_, 𝟙 _, _, hg, id_comp _⟩,
 λ ss Y f,
  begin
    rintro ⟨Z, f, g, hg, rfl⟩,
    exact S.downward_closed (ss Z hg) f,
  end⟩

/-- Show that there is a galois insertion (generate, set_over). -/
def gi_generate : galois_insertion (generate : presieve X → sieve X) arrows :=
{ gc := sets_iff_generate,
  choice := λ 𝒢 _, generate 𝒢,
  choice_eq := λ _ _, rfl,
  le_l_u := λ S Y f hf, ⟨_, 𝟙 _, _, hf, id_comp _⟩ }

lemma le_generate (R : presieve X) : R ≤ generate R :=
gi_generate.gc.le_u_l R

@[simp] lemma generate_sieve (S : sieve X) : generate S = S :=
gi_generate.l_u_eq S

/-- If the identity arrow is in a sieve, the sieve is maximal. -/
lemma id_mem_iff_eq_top : S (𝟙 X) ↔ S = ⊤ :=
⟨λ h, top_unique $ λ Y f _, by simpa using downward_closed _ h f,
 λ h, h.symm ▸ trivial⟩

/-- If an arrow set contains a split epi, it generates the maximal sieve. -/
lemma generate_of_contains_is_split_epi {R : presieve X} (f : Y ⟶ X) [is_split_epi f]
  (hf : R f) : generate R = ⊤ :=
begin
  rw ← id_mem_iff_eq_top,
  exact ⟨_, section_ f, f, hf, by simp⟩,
end

@[simp]
lemma generate_of_singleton_is_split_epi (f : Y ⟶ X) [is_split_epi f] :
  generate (presieve.singleton f) = ⊤ :=
generate_of_contains_is_split_epi f (presieve.singleton_self _)

@[simp]
lemma generate_top : generate (⊤ : presieve X) = ⊤ :=
generate_of_contains_is_split_epi (𝟙 _) ⟨⟩

/-- Given a morphism `h : Y ⟶ X`, send a sieve S on X to a sieve on Y
    as the inverse image of S with `_ ≫ h`.
    That is, `sieve.pullback S h := (≫ h) '⁻¹ S`. -/
@[simps]
def pullback (h : Y ⟶ X) (S : sieve X) : sieve Y :=
{ arrows := λ Y sl, S (sl ≫ h),
  downward_closed' := λ Z W f g h, by simp [g] }

@[simp]
lemma pullback_id : S.pullback (𝟙 _) = S :=
by simp [sieve.ext_iff]

@[simp]
lemma pullback_top {f : Y ⟶ X} : (⊤ : sieve X).pullback f = ⊤ :=
top_unique (λ _ g, id)

lemma pullback_comp {f : Y ⟶ X} {g : Z ⟶ Y} (S : sieve X) :
  S.pullback (g ≫ f) = (S.pullback f).pullback g :=
by simp [sieve.ext_iff]

@[simp]
lemma pullback_inter {f : Y ⟶ X} (S R : sieve X) :
 (S ⊓ R).pullback f = S.pullback f ⊓ R.pullback f :=
by simp [sieve.ext_iff]

lemma pullback_eq_top_iff_mem (f : Y ⟶ X) : S f ↔ S.pullback f = ⊤ :=
by rw [← id_mem_iff_eq_top, pullback_apply, id_comp]

lemma pullback_eq_top_of_mem (S : sieve X) {f : Y ⟶ X} : S f → S.pullback f = ⊤ :=
(pullback_eq_top_iff_mem f).1

/--
Push a sieve `R` on `Y` forward along an arrow `f : Y ⟶ X`: `gf : Z ⟶ X` is in the sieve if `gf`
factors through some `g : Z ⟶ Y` which is in `R`.
-/
@[simps]
def pushforward (f : Y ⟶ X) (R : sieve Y) : sieve X :=
{ arrows := λ Z gf, ∃ g, g ≫ f = gf ∧ R g,
  downward_closed' := λ Z₁ Z₂ g ⟨j, k, z⟩ h, ⟨h ≫ j, by simp [k], by simp [z]⟩ }

lemma pushforward_apply_comp {R : sieve Y} {Z : C} {g : Z ⟶ Y} (hg : R g) (f : Y ⟶ X) :
  R.pushforward f (g ≫ f) :=
⟨g, rfl, hg⟩

lemma pushforward_comp {f : Y ⟶ X} {g : Z ⟶ Y} (R : sieve Z) :
  R.pushforward (g ≫ f) = (R.pushforward g).pushforward f :=
sieve.ext (λ W h, ⟨λ ⟨f₁, hq, hf₁⟩, ⟨f₁ ≫ g, by simpa, f₁, rfl, hf₁⟩,
                   λ ⟨y, hy, z, hR, hz⟩, ⟨z, by rwa reassoc_of hR, hz⟩⟩)

lemma galois_connection (f : Y ⟶ X) : galois_connection (sieve.pushforward f) (sieve.pullback f) :=
λ S R, ⟨λ hR Z g hg, hR _ ⟨g, rfl, hg⟩, λ hS Z g ⟨h, hg, hh⟩, hg ▸ hS h hh⟩

lemma pullback_monotone (f : Y ⟶ X) : monotone (sieve.pullback f) :=
(galois_connection f).monotone_u

lemma pushforward_monotone (f : Y ⟶ X) : monotone (sieve.pushforward f) :=
(galois_connection f).monotone_l

lemma le_pushforward_pullback (f : Y ⟶ X) (R : sieve Y) :
  R ≤ (R.pushforward f).pullback f :=
(galois_connection f).le_u_l _

lemma pullback_pushforward_le (f : Y ⟶ X) (R : sieve X) :
  (R.pullback f).pushforward f ≤ R :=
(galois_connection f).l_u_le _

lemma pushforward_union {f : Y ⟶ X} (S R : sieve Y) :
  (S ⊔ R).pushforward f = S.pushforward f ⊔ R.pushforward f :=
(galois_connection f).l_sup

lemma pushforward_le_bind_of_mem (S : presieve X)
  (R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y) (f : Y ⟶ X) (h : S f) :
  (R h).pushforward f ≤ bind S R :=
begin
  rintro Z _ ⟨g, rfl, hg⟩,
  exact ⟨_, g, f, h, hg, rfl⟩,
end

lemma le_pullback_bind (S : presieve X) (R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y)
  (f : Y ⟶ X) (h : S f) :
  R h ≤ (bind S R).pullback f :=
begin
  rw ← galois_connection f,
  apply pushforward_le_bind_of_mem,
end

/-- If `f` is a monomorphism, the pushforward-pullback adjunction on sieves is coreflective. -/
def galois_coinsertion_of_mono (f : Y ⟶ X) [mono f] :
  galois_coinsertion (sieve.pushforward f) (sieve.pullback f) :=
begin
  apply (galois_connection f).to_galois_coinsertion,
  rintros S Z g ⟨g₁, hf, hg₁⟩,
  rw cancel_mono f at hf,
  rwa ← hf,
end

/-- If `f` is a split epi, the pushforward-pullback adjunction on sieves is reflective. -/
def galois_insertion_of_is_split_epi (f : Y ⟶ X) [is_split_epi f] :
  galois_insertion (sieve.pushforward f) (sieve.pullback f) :=
begin
  apply (galois_connection f).to_galois_insertion,
  intros S Z g hg,
  refine ⟨g ≫ section_ f, by simpa⟩,
end

lemma pullback_arrows_comm [has_pullbacks C] {X Y : C} (f : Y ⟶ X)
  (R : presieve X) :
  sieve.generate (R.pullback_arrows f) = (sieve.generate R).pullback f :=
begin
  ext Z g,
  split,
  { rintro ⟨_, h, k, hk, rfl⟩,
    cases hk with W g hg,
    change (sieve.generate R).pullback f (h ≫ pullback.snd),
    rw [sieve.pullback_apply, assoc, ← pullback.condition, ← assoc],
    exact sieve.downward_closed _ (sieve.le_generate R W hg) (h ≫ pullback.fst)},
  { rintro ⟨W, h, k, hk, comm⟩,
    exact ⟨_, _, _, presieve.pullback_arrows.mk _ _ hk, pullback.lift_snd _ _ comm⟩ },
end

section functor
variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E)

/--
If `R` is a sieve, then the `category_theory.presieve.functor_pullback` of `R` is actually a sieve.
-/
@[simps] def functor_pullback (R : sieve (F.obj X)) : sieve X :=
{ arrows := presieve.functor_pullback F R,
  downward_closed' := λ _ _ f hf g,
  begin
    unfold presieve.functor_pullback,
    rw F.map_comp,
    exact R.downward_closed hf (F.map g),
  end }

@[simp] lemma functor_pullback_arrows (R : sieve (F.obj X)) :
  (R.functor_pullback F).arrows = R.arrows.functor_pullback F := rfl

@[simp] lemma functor_pullback_id (R : sieve X) : R.functor_pullback (𝟭 _) = R :=
by { ext, refl }

lemma functor_pullback_comp (R : sieve ((F ⋙ G).obj X)) :
  R.functor_pullback (F ⋙ G) = (R.functor_pullback G).functor_pullback F := by { ext, refl }

lemma functor_pushforward_extend_eq {R : presieve X} :
  (generate R).arrows.functor_pushforward F = R.functor_pushforward F :=
begin
  ext Y f, split,
  { rintro ⟨X', g, f', ⟨X'', g', f'', h₁, rfl⟩, rfl⟩,
    exact ⟨X'', f'', f' ≫ F.map g', h₁, by simp⟩ },
  { rintro ⟨X', g, f', h₁, h₂⟩, exact ⟨X', g, f', le_generate R _ h₁, h₂⟩ }
end

/-- The sieve generated by the image of `R` under `F`. -/
@[simps] def functor_pushforward (R : sieve X) : sieve (F.obj X) :=
{ arrows := R.arrows.functor_pushforward F,
  downward_closed' := λ Y Z f h g, by
  { obtain ⟨X, α, β, hα, rfl⟩ := h,
    exact ⟨X, α, g ≫ β, hα, by simp⟩ } }

@[simp] lemma functor_pushforward_id (R : sieve X) :
  R.functor_pushforward (𝟭 _) = R :=
begin
  ext X f,
  split,
  { intro hf,
    obtain ⟨X, g, h, hg, rfl⟩ := hf,
    exact R.downward_closed hg h, },
  { intro hf,
    exact ⟨X, f, 𝟙 _, hf, by simp⟩ }
end

lemma functor_pushforward_comp (R : sieve X) :
  R.functor_pushforward (F ⋙ G) = (R.functor_pushforward F).functor_pushforward G :=
by { ext, simpa [R.arrows.functor_pushforward_comp F G] }

lemma functor_galois_connection (X : C) :
  _root_.galois_connection
    (sieve.functor_pushforward F : sieve X → sieve (F.obj X))
    (sieve.functor_pullback F) :=
begin
  intros R S,
  split,
  { intros hle X f hf,
    apply hle,
    refine ⟨X, f, 𝟙 _, hf, _⟩,
    rw id_comp, },
  { rintros hle Y f ⟨X, g, h, hg, rfl⟩,
    apply sieve.downward_closed S,
    exact hle g hg, }
end

lemma functor_pullback_monotone (X : C) :
  monotone (sieve.functor_pullback F : sieve (F.obj X) → sieve X) :=
(functor_galois_connection F X).monotone_u

lemma functor_pushforward_monotone (X : C) :
  monotone (sieve.functor_pushforward F : sieve X → sieve (F.obj X)) :=
(functor_galois_connection F X).monotone_l

lemma le_functor_pushforward_pullback (R : sieve X) :
  R ≤ (R.functor_pushforward F).functor_pullback F :=
(functor_galois_connection F X).le_u_l _

lemma functor_pullback_pushforward_le (R : sieve (F.obj X)) :
  (R.functor_pullback F).functor_pushforward F ≤ R :=
(functor_galois_connection F X).l_u_le _

lemma functor_pushforward_union (S R : sieve X) :
  (S ⊔ R).functor_pushforward F = S.functor_pushforward F ⊔ R.functor_pushforward F :=
(functor_galois_connection F X).l_sup

lemma functor_pullback_union (S R : sieve (F.obj X)) :
  (S ⊔ R).functor_pullback F = S.functor_pullback F ⊔ R.functor_pullback F := rfl

lemma functor_pullback_inter (S R : sieve (F.obj X)) :
  (S ⊓ R).functor_pullback F = S.functor_pullback F ⊓ R.functor_pullback F := rfl

@[simp] lemma functor_pushforward_bot (F : C ⥤ D) (X : C) :
  (⊥ : sieve X).functor_pushforward F = ⊥ := (functor_galois_connection F X).l_bot

@[simp] lemma functor_pushforward_top (F : C ⥤ D) (X : C) :
  (⊤ : sieve X).functor_pushforward F = ⊤ :=
  begin
    refine (generate_sieve _).symm.trans _,
    apply generate_of_contains_is_split_epi (𝟙 (F.obj X)),
    refine ⟨X, 𝟙 _, 𝟙 _, trivial, by simp⟩
  end

@[simp] lemma functor_pullback_bot (F : C ⥤ D) (X : C) :
  (⊥ : sieve (F.obj X)).functor_pullback F = ⊥ := rfl

@[simp] lemma functor_pullback_top (F : C ⥤ D) (X : C) :
  (⊤ : sieve (F.obj X)).functor_pullback F = ⊤ := rfl

lemma image_mem_functor_pushforward (R : sieve X) {V} {f : V ⟶ X} (h : R f) :
  R.functor_pushforward F (F.map f) := ⟨V, f, 𝟙 _, h, by simp⟩

/-- When `F` is essentially surjective and full, the galois connection is a galois insertion. -/
def ess_surj_full_functor_galois_insertion [ess_surj F] [full F] (X : C) :
  galois_insertion
    (sieve.functor_pushforward F : sieve X → sieve (F.obj X))
    (sieve.functor_pullback F) :=
begin
  apply (functor_galois_connection F X).to_galois_insertion,
  intros S Y f hf,
  refine ⟨_, F.preimage ((F.obj_obj_preimage_iso Y).hom ≫ f), (F.obj_obj_preimage_iso Y).inv, _⟩,
  simpa using S.downward_closed hf _,
end

/-- When `F` is fully faithful, the galois connection is a galois coinsertion. -/
def fully_faithful_functor_galois_coinsertion [full F] [faithful F] (X : C) :
  galois_coinsertion
    (sieve.functor_pushforward F : sieve X → sieve (F.obj X))
    (sieve.functor_pullback F) :=
begin
  apply (functor_galois_connection F X).to_galois_coinsertion,
  rintros S Y f ⟨Z, g, h, h₁, h₂⟩,
  rw [←F.image_preimage h, ←F.map_comp] at h₂,
  rw F.map_injective h₂,
  exact S.downward_closed h₁ _,
end

end functor

/-- A sieve induces a presheaf. -/
@[simps]
def functor (S : sieve X) : Cᵒᵖ ⥤ Type v₁ :=
{ obj := λ Y, {g : Y.unop ⟶ X // S g},
  map := λ Y Z f g, ⟨f.unop ≫ g.1, downward_closed _ g.2 _⟩ }

/--
If a sieve S is contained in a sieve T, then we have a morphism of presheaves on their induced
presheaves.
-/
@[simps]
def nat_trans_of_le {S T : sieve X} (h : S ≤ T) : S.functor ⟶ T.functor :=
{ app := λ Y f, ⟨f.1, h _ f.2⟩ }.

/-- The natural inclusion from the functor induced by a sieve to the yoneda embedding. -/
@[simps]
def functor_inclusion (S : sieve X) : S.functor ⟶ yoneda.obj X :=
{ app := λ Y f, f.1 }.

lemma nat_trans_of_le_comm {S T : sieve X} (h : S ≤ T) :
  nat_trans_of_le h ≫ functor_inclusion _ = functor_inclusion _ :=
rfl

/-- The presheaf induced by a sieve is a subobject of the yoneda embedding. -/
instance functor_inclusion_is_mono : mono S.functor_inclusion :=
⟨λ Z f g h, by { ext Y y, apply congr_fun (nat_trans.congr_app h Y) y }⟩

/--
A natural transformation to a representable functor induces a sieve. This is the left inverse of
`functor_inclusion`, shown in `sieve_of_functor_inclusion`.
-/
-- TODO: Show that when `f` is mono, this is right inverse to `functor_inclusion` up to isomorphism.
@[simps]
def sieve_of_subfunctor {R} (f : R ⟶ yoneda.obj X) : sieve X :=
{ arrows := λ Y g, ∃ t, f.app (opposite.op Y) t = g,
  downward_closed' := λ Y Z _,
  begin
    rintro ⟨t, rfl⟩ g,
    refine ⟨R.map g.op t, _⟩,
    rw functor_to_types.naturality _ _ f,
    simp,
  end }

lemma sieve_of_subfunctor_functor_inclusion : sieve_of_subfunctor S.functor_inclusion = S :=
begin
  ext,
  simp only [functor_inclusion_app, sieve_of_subfunctor_apply, subtype.val_eq_coe],
  split,
  { rintro ⟨⟨f, hf⟩, rfl⟩,
    exact hf },
  { intro hf,
    exact ⟨⟨_, hf⟩, rfl⟩ }
end

instance functor_inclusion_top_is_iso : is_iso ((⊤ : sieve X).functor_inclusion) :=
⟨⟨{ app := λ Y a, ⟨a, ⟨⟩⟩ }, by tidy⟩⟩

end sieve
end category_theory


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

import analysis.special_functions.complex.circle
import measure_theory.group.integration
import measure_theory.integral.integral_eq_improper

/-!
# The Fourier transform

We set up the Fourier transform for complex-valued functions on finite-dimensional spaces.

## Design choices

In namespace `vector_fourier`, we define the Fourier integral in the following context:
* `𝕜` is a commutative ring.
* `V` and `W` are `𝕜`-modules.
* `e` is a unitary additive character of `𝕜`, i.e. a homomorphism `(multiplicative 𝕜) →* circle`.
* `μ` is a measure on `V`.
* `L` is a `𝕜`-bilinear form `V × W → 𝕜`.
* `E` is a complete normed `ℂ`-vector space.

With these definitions, we define `fourier_integral` to be the map from functions `V → E` to
functions `W → E` that sends `f` to

`λ w, ∫ v in V, e [-L v w] • f v ∂μ`,

where `e [x]` is notational sugar for `(e (multiplicative.of_add x) : ℂ)` (available in locale
`fourier_transform`). This includes the cases `W` is the dual of `V` and `L` is the canonical
pairing, or `W = V` and `L` is a bilinear form (e.g. an inner product).

In namespace `fourier`, we consider the more familiar special case when `V = W = 𝕜` and `L` is the
multiplication map (but still allowing `𝕜` to be an arbitrary ring equipped with a measure).

The most familiar case of all is when `V = W = 𝕜 = ℝ`, `L` is multiplication, `μ` is volume, and
`e` is `real.fourier_char`, i.e. the character `λ x, exp ((2 * π * x) * I)`. The Fourier integral
in this case is defined as `real.fourier_integral`.

## Main results

At present the only nontrivial lemma we prove is `continuous_fourier_integral`, stating that the
Fourier transform of an integrable function is continuous (under mild assumptions).
-/

noncomputable theory

local notation `𝕊` := circle

open measure_theory filter

open_locale topology

-- To avoid messing around with multiplicative vs. additive characters, we make a notation.
localized "notation e `[` x `]` := (e (multiplicative.of_add x) : ℂ)" in fourier_transform

/-! ## Fourier theory for functions on general vector spaces -/
namespace vector_fourier

variables
  {𝕜 : Type*} [comm_ring 𝕜]
  {V : Type*} [add_comm_group V] [module 𝕜 V] [measurable_space V]
  {W : Type*} [add_comm_group W] [module 𝕜 W]
  {E : Type*} [normed_add_comm_group E] [normed_space ℂ E]

section defs

variables [complete_space E]

/-- The Fourier transform integral for `f : V → E`, with respect to a bilinear form `L : V × W → 𝕜`
and an additive character `e`. -/
def fourier_integral
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜)
  (f : V → E) (w : W) : E :=
∫ v, e [-L v w] • f v ∂μ

lemma fourier_integral_smul_const
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜)
  (f : V → E) (r : ℂ) :
  fourier_integral e μ L (r • f) = r • (fourier_integral e μ L f) :=
begin
  ext1 w,
  simp only [pi.smul_apply, fourier_integral, smul_comm _ r, integral_smul],
end

/-- The uniform norm of the Fourier integral of `f` is bounded by the `L¹` norm of `f`. -/
lemma fourier_integral_norm_le (e : (multiplicative 𝕜) →* 𝕊) {μ : measure V}
  (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) {f : V → E} (hf : integrable f μ) (w : W) :
  ‖fourier_integral e μ L f w‖ ≤ ‖hf.to_L1 f‖ :=
begin
  rw L1.norm_of_fun_eq_integral_norm,
  refine (norm_integral_le_integral_norm _).trans (le_of_eq _),
  simp_rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul],
end

/-- The Fourier integral converts right-translation into scalar multiplication by a phase factor.-/
lemma fourier_integral_comp_add_right [has_measurable_add V]
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) [μ.is_add_right_invariant]
  (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E) (v₀ : V) :
  fourier_integral e μ L (f ∘ (λ v, v + v₀)) = λ w, e [L v₀ w] • fourier_integral e μ L f w :=
begin
  ext1 w,
  dsimp only [fourier_integral, function.comp_apply],
  conv in (L _) { rw ←add_sub_cancel v v₀ },
  rw integral_add_right_eq_self (λ (v : V), e [-L (v - v₀) w] • f v),
  swap, apply_instance,
  dsimp only,
  rw ←integral_smul,
  congr' 1 with v,
  rw [←smul_assoc, smul_eq_mul, ←submonoid.coe_mul, ←e.map_mul, ←of_add_add, ←linear_map.neg_apply,
    ←sub_eq_add_neg, ←linear_map.sub_apply, linear_map.map_sub, neg_sub]
end

end defs

section continuous
/- In this section we assume 𝕜, V, W have topologies, and L, e are continuous (but f needn't be).
   This is used to ensure that `e [-L v w]` is (ae strongly) measurable. We could get away with
   imposing only a measurable-space structure on 𝕜 (it doesn't have to be the Borel sigma-algebra of
   a topology); but it seems hard to imagine cases where this extra generality would be useful, and
   allowing it would complicate matters in the most important use cases.
-/

variables [topological_space 𝕜] [topological_ring 𝕜] [topological_space V] [borel_space V]
  [topological_space W] {e : (multiplicative 𝕜) →* 𝕊} {μ : measure V} {L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜}

/-- If `f` is integrable, then the Fourier integral is convergent for all `w`. -/
lemma fourier_integral_convergent
  (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2))
  {f : V → E} (hf : integrable f μ) (w : W) :
  integrable (λ (v : V), (e [-L v w]) • f v) μ :=
begin
  rw continuous_induced_rng at he,
  have c : continuous (λ v, e[-L v w]),
  { refine he.comp (continuous_of_add.comp (continuous.neg _)),
    exact hL.comp (continuous_prod_mk.mpr ⟨continuous_id, continuous_const⟩) },
  rw ←integrable_norm_iff (c.ae_strongly_measurable.smul hf.1),
  convert hf.norm,
  ext1 v,
  rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul]
end

variables [complete_space E]

lemma fourier_integral_add
  (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2))
  {f g : V → E} (hf : integrable f μ) (hg : integrable g μ) :
  (fourier_integral e μ L f) + (fourier_integral e μ L g) = fourier_integral e μ L (f + g) :=
begin
  ext1 w,
  dsimp only [pi.add_apply, fourier_integral],
  simp_rw smul_add,
  rw integral_add,
  { exact fourier_integral_convergent he hL hf w },
  { exact fourier_integral_convergent he hL hg w },
end

/-- The Fourier integral of an `L^1` function is a continuous function. -/
lemma fourier_integral_continuous [topological_space.first_countable_topology W]
  (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2))
  {f : V → E} (hf : integrable f μ) :
  continuous (fourier_integral e μ L f) :=
begin
  apply continuous_of_dominated,
  { exact λ w, (fourier_integral_convergent he hL hf w).1 },
  { refine λ w, ae_of_all _ (λ v, _),
    { exact λ v, ‖f v‖ },
    { rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul] } },
  { exact hf.norm },
  { rw continuous_induced_rng at he,
    refine ae_of_all _ (λ v, (he.comp (continuous_of_add.comp _)).smul continuous_const),
    refine (hL.comp (continuous_prod_mk.mpr ⟨continuous_const, continuous_id⟩)).neg }
end

end continuous

end vector_fourier

/-! ## Fourier theory for functions on `𝕜` -/
namespace fourier

variables {𝕜 : Type*} [comm_ring 𝕜] [measurable_space 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space ℂ E]

section defs

variables [complete_space E]

/-- The Fourier transform integral for `f : 𝕜 → E`, with respect to the measure `μ` and additive
character `e`. -/
def fourier_integral
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (w : 𝕜) : E :=
vector_fourier.fourier_integral e μ (linear_map.mul 𝕜 𝕜) f w

lemma fourier_integral_def (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (w : 𝕜) :
  fourier_integral e μ f w = ∫ (v : 𝕜), e[-(v * w)] • f v ∂μ :=
rfl

lemma fourier_integral_smul_const
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (r : ℂ) :
  fourier_integral e μ (r • f) = r • (fourier_integral e μ f) :=
vector_fourier.fourier_integral_smul_const _ _ _ _ _

/-- The uniform norm of the Fourier transform of `f` is bounded by the `L¹` norm of `f`. -/
lemma fourier_integral_norm_le (e : (multiplicative 𝕜) →* 𝕊) {μ : measure 𝕜}
  {f : 𝕜 → E} (hf : integrable f μ) (w : 𝕜) :
  ‖fourier_integral e μ f w‖ ≤ ‖hf.to_L1 f‖ :=
vector_fourier.fourier_integral_norm_le _ _ _ _

/-- The Fourier transform converts right-translation into scalar multiplication by a phase factor.-/
lemma fourier_integral_comp_add_right [has_measurable_add 𝕜]
  (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) [μ.is_add_right_invariant] (f : 𝕜 → E) (v₀ : 𝕜) :
  fourier_integral e μ (f ∘ (λ v, v + v₀)) = λ w, e [v₀ * w] • fourier_integral e μ f w :=
vector_fourier.fourier_integral_comp_add_right _ _ _ _ _

end defs

end fourier

open_locale real

namespace real

/-- The standard additive character of `ℝ`, given by `λ x, exp (2 * π * x * I)`. -/
def fourier_char : (multiplicative ℝ) →* 𝕊 :=
{ to_fun := λ z, exp_map_circle (2 * π * z.to_add),
  map_one' := by rw [to_add_one, mul_zero, exp_map_circle_zero],
  map_mul' := λ x y, by rw [to_add_mul, mul_add, exp_map_circle_add] }

lemma fourier_char_apply (x : ℝ) :
  real.fourier_char [x] = complex.exp (↑(2 * π * x) * complex.I) :=
by refl

@[continuity]
lemma continuous_fourier_char : continuous real.fourier_char :=
(map_continuous exp_map_circle).comp (continuous_const.mul continuous_to_add)

variables {E : Type*} [normed_add_comm_group E] [complete_space E] [normed_space ℂ E]

lemma vector_fourier_integral_eq_integral_exp_smul
  {V : Type*} [add_comm_group V] [module ℝ V] [measurable_space V]
  {W : Type*} [add_comm_group W] [module ℝ W]
  (L : V →ₗ[ℝ] W →ₗ[ℝ] ℝ) (μ : measure V) (f : V → E) (w : W) :
  vector_fourier.fourier_integral fourier_char μ L f w
  = ∫ (v : V), complex.exp (↑(-2 * π * L v w) * complex.I) • f v ∂μ :=
by simp_rw [vector_fourier.fourier_integral, real.fourier_char_apply, mul_neg, neg_mul]

/-- The Fourier integral for `f : ℝ → E`, with respect to the standard additive character and
measure on `ℝ`. -/
def fourier_integral (f : ℝ → E) (w : ℝ) := fourier.fourier_integral fourier_char volume f w

lemma fourier_integral_def (f : ℝ → E) (w : ℝ) :
  fourier_integral f w = ∫ (v : ℝ), fourier_char [-(v * w)] • f v :=
rfl

localized "notation (name := fourier_integral) `𝓕` := real.fourier_integral" in fourier_transform

lemma fourier_integral_eq_integral_exp_smul
  {E : Type*} [normed_add_comm_group E] [complete_space E] [normed_space ℂ E]
  (f : ℝ → E) (w : ℝ) :
  𝓕 f w = ∫ (v : ℝ), complex.exp (↑(-2 * π * v * w) * complex.I) • f v :=
by simp_rw [fourier_integral_def, real.fourier_char_apply, mul_neg, neg_mul, mul_assoc]

end real


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

! This file was ported from Lean 3 source module algebra.monoid_algebra.no_zero_divisors
! leanprover-community/mathlib commit 932872382355f00112641d305ba0619305dc8642
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.MonoidAlgebra.Support

/-!
# Variations on non-zero divisors in `add_monoid_algebra`s

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file studies the interaction between typeclass assumptions on two Types `R` and `A` and
whether `add_monoid_algebra R A` has non-zero zero-divisors.  For some background on related
questions, see [Kaplansky's Conjectures](https://en.wikipedia.org/wiki/Kaplansky%27s_conjectures),
especially the *zero divisor conjecture*.

_Conjecture._
Let `K` be a field, and `G` a torsion-free group. The group ring `K[G]` does not contain
nontrivial zero divisors, that is, it is a domain.

We formalize in this file the well-known result that if `R` is a field and `A` is a left-ordered
group, then `R[A]` contains no non-zero zero-divisors.  Some of these assumptions can be trivially
weakened: below we mention what assumptions are sufficient for the proofs in this file.

##  Main results

* `no_zero_divisors.of_left_ordered` shows that if `R` is a semiring with no non-zero
  zero-divisors, `A` is a linearly ordered, add right cancel semigroup with strictly monotone
  left addition, then `add_monoid_algebra R A` has no non-zero zero-divisors.
* `no_zero_divisors.of_right_ordered` shows that if `R` is a semiring with no non-zero
  zero-divisors, `A` is a linearly ordered, add left cancel semigroup with strictly monotone
  right addition, then `add_monoid_algebra R A` has no non-zero zero-divisors.

The conditions on `A` imposed in `no_zero_divisors.of_left_ordered` are sometimes referred to as
`left-ordered`.
The conditions on `A` imposed in `no_zero_divisors.of_right_ordered` are sometimes referred to as
`right-ordered`.

These conditions are sufficient, but not necessary.  As mentioned above, *Kaplansky's Conjecture*
asserts that `A` being torsion-free may be enough.
-/

namespace AddMonoidAlgebra

open Finsupp

variable {R A : Type _} [Semiring R]

/- warning: add_monoid_algebra.mul_apply_add_eq_mul_of_forall_ne -> AddMonoidAlgebra.mul_apply_add_eq_mul_of_forall_ne is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : Add.{u2} A] {f : AddMonoidAlgebra.{u1, u2} R A _inst_1} {g : AddMonoidAlgebra.{u1, u2} R A _inst_1} {a0 : A} {b0 : A}, (forall {a : A} {b : A}, (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) a (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) f)) -> (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) b (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) g)) -> (Or (Ne.{succ u2} A a a0) (Ne.{succ u2} A b b0)) -> (Ne.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a b) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a0 b0))) -> (Eq.{succ u1} R (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (fun (_x : AddMonoidAlgebra.{u1, u2} R A _inst_1) => A -> R) (AddMonoidAlgebra.coeFun.{u1, u2} R A _inst_1) (HMul.hMul.{max u2 u1, max u2 u1, max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 _inst_2)) f g) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a0 b0)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))) (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (fun (_x : AddMonoidAlgebra.{u1, u2} R A _inst_1) => A -> R) (AddMonoidAlgebra.coeFun.{u1, u2} R A _inst_1) f a0) (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (fun (_x : AddMonoidAlgebra.{u1, u2} R A _inst_1) => A -> R) (AddMonoidAlgebra.coeFun.{u1, u2} R A _inst_1) g b0)))
but is expected to have type
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : Add.{u2} A] {f : AddMonoidAlgebra.{u1, u2} R A _inst_1} {g : AddMonoidAlgebra.{u1, u2} R A _inst_1} {a0 : A} {b0 : A}, (forall {a : A} {b : A}, (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) a (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) f)) -> (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) b (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) g)) -> (Or (Ne.{succ u2} A a a0) (Ne.{succ u2} A b b0)) -> (Ne.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a b) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a0 b0))) -> (Eq.{succ u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a0 b0)) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) A (fun (_x : A) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) _x) (Finsupp.funLike.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) (HMul.hMul.{max u1 u2, max u1 u2, max u1 u2} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u1 u2} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 _inst_2)) f g) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A _inst_2) a0 b0)) (HMul.hMul.{u1, u1, u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) b0) ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) (instHMul.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) (NonUnitalNonAssocSemiring.toMul.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) (Semiring.toNonAssocSemiring.{u1} ((fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) a0) _inst_1)))) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) A (fun (_x : A) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) _x) (Finsupp.funLike.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) f a0) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Finsupp.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) A (fun (_x : A) => (fun (x._@.Mathlib.Data.Finsupp.Defs._hyg.779 : A) => R) _x) (Finsupp.funLike.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))) g b0)))
Case conversion may be inaccurate. Consider using '#align add_monoid_algebra.mul_apply_add_eq_mul_of_forall_ne AddMonoidAlgebra.mul_apply_add_eq_mul_of_forall_neₓ'. -/
/-- The coefficient of a monomial in a product `f * g` that can be reached in at most one way
as a product of monomials in the supports of `f` and `g` is a product. -/
theorem mul_apply_add_eq_mul_of_forall_ne [Add A] {f g : AddMonoidAlgebra R A} {a0 b0 : A}
    (h : ∀ {a b : A}, a ∈ f.support → b ∈ g.support → a ≠ a0 ∨ b ≠ b0 → a + b ≠ a0 + b0) :
    (f * g) (a0 + b0) = f a0 * g b0 := by
  classical
    rw [mul_apply]
    refine' (Finset.sum_eq_single a0 _ _).trans _
    · exact fun b H hb => Finset.sum_eq_zero fun x H1 => if_neg (h H H1 (Or.inl hb))
    · exact fun af0 => by simp [not_mem_support_iff.mp af0]
    · refine' (Finset.sum_eq_single b0 (fun b bg b0 => _) _).trans (if_pos rfl)
      · by_cases af : a0 ∈ f.support
        · exact if_neg (h af bg (Or.inr b0))
        · simp only [not_mem_support_iff.mp af, MulZeroClass.zero_mul, if_t_t]
      · exact fun bf0 => by simp [not_mem_support_iff.mp bf0]
#align add_monoid_algebra.mul_apply_add_eq_mul_of_forall_ne AddMonoidAlgebra.mul_apply_add_eq_mul_of_forall_ne

section LeftOrRightOrderability

/- warning: add_monoid_algebra.left.exists_add_of_mem_support_single_mul -> AddMonoidAlgebra.Left.exists_add_of_mem_support_single_mul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : AddLeftCancelSemigroup.{u2} A] {g : AddMonoidAlgebra.{u1, u2} R A _inst_1} (a : A) (x : A), (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) x (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (HMul.hMul.{max u2 u1, max u2 u1, max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_2)))) (Finsupp.single.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) a (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))))))) g))) -> (Exists.{succ u2} A (fun (b : A) => Exists.{0} (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) b (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) g)) (fun (H : Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) b (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) g)) => Eq.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toHasAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_2))) a b) x)))
but is expected to have type
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : AddLeftCancelSemigroup.{u2} A] {g : AddMonoidAlgebra.{u1, u2} R A _inst_1} (a : A) (x : A), (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) x (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) (HMul.hMul.{max u2 u1, max u1 u2, max u1 u2} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_2)))) (AddMonoidAlgebra.single.{u1, u2} R A _inst_1 a (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Semiring.toOne.{u1} R _inst_1)))) g))) -> (Exists.{succ u2} A (fun (b : A) => And (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) b (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) g)) (Eq.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_2))) a b) x)))
Case conversion may be inaccurate. Consider using '#align add_monoid_algebra.left.exists_add_of_mem_support_single_mul AddMonoidAlgebra.Left.exists_add_of_mem_support_single_mulₓ'. -/
theorem Left.exists_add_of_mem_support_single_mul [AddLeftCancelSemigroup A]
    {g : AddMonoidAlgebra R A} (a x : A)
    (hx : x ∈ (single a 1 * g : AddMonoidAlgebra R A).support) : ∃ b ∈ g.support, a + b = x := by
  rwa [support_single_mul _ _ (fun y => by rw [one_mul] : ∀ y : R, 1 * y = 0 ↔ _),
    Finset.mem_map] at hx
#align add_monoid_algebra.left.exists_add_of_mem_support_single_mul AddMonoidAlgebra.Left.exists_add_of_mem_support_single_mul

/- warning: add_monoid_algebra.right.exists_add_of_mem_support_single_mul -> AddMonoidAlgebra.Right.exists_add_of_mem_support_single_mul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : AddRightCancelSemigroup.{u2} A] {f : AddMonoidAlgebra.{u1, u2} R A _inst_1} (b : A) (x : A), (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) x (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (HMul.hMul.{max u2 u1, max u2 u1, max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_2)))) f (Finsupp.single.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) b (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (AddMonoidWithOne.toOne.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))))))))) -> (Exists.{succ u2} A (fun (a : A) => Exists.{0} (Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) a (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) f)) (fun (H : Membership.Mem.{u2, u2} A (Finset.{u2} A) (Finset.hasMem.{u2} A) a (Finsupp.support.{u2, u1} A R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) f)) => Eq.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toHasAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_2))) a b) x)))
but is expected to have type
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : AddRightCancelSemigroup.{u2} A] {f : AddMonoidAlgebra.{u1, u2} R A _inst_1} (b : A) (x : A), (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) x (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) (HMul.hMul.{max u1 u2, max u2 u1, max u1 u2} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.{u1, u2} R A _inst_1) (instHMul.{max u1 u2} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_2)))) f (AddMonoidAlgebra.single.{u1, u2} R A _inst_1 b (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Semiring.toOne.{u1} R _inst_1))))))) -> (Exists.{succ u2} A (fun (a : A) => And (Membership.mem.{u2, u2} A (Finset.{u2} A) (Finset.instMembershipFinset.{u2} A) a (Finsupp.support.{u2, u1} A R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1)) f)) (Eq.{succ u2} A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_2))) a b) x)))
Case conversion may be inaccurate. Consider using '#align add_monoid_algebra.right.exists_add_of_mem_support_single_mul AddMonoidAlgebra.Right.exists_add_of_mem_support_single_mulₓ'. -/
theorem Right.exists_add_of_mem_support_single_mul [AddRightCancelSemigroup A]
    {f : AddMonoidAlgebra R A} (b x : A)
    (hx : x ∈ (f * single b 1 : AddMonoidAlgebra R A).support) : ∃ a ∈ f.support, a + b = x := by
  rwa [support_mul_single _ _ (fun y => by rw [mul_one] : ∀ y : R, y * 1 = 0 ↔ _),
    Finset.mem_map] at hx
#align add_monoid_algebra.right.exists_add_of_mem_support_single_mul AddMonoidAlgebra.Right.exists_add_of_mem_support_single_mul

/- warning: add_monoid_algebra.no_zero_divisors.of_left_ordered -> AddMonoidAlgebra.NoZeroDivisors.of_left_ordered is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))] [_inst_3 : AddRightCancelSemigroup.{u2} A] [_inst_4 : LinearOrder.{u2} A] [_inst_5 : CovariantClass.{u2, u2} A A (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toHasAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_3)))) (LT.lt.{u2} A (Preorder.toLT.{u2} A (PartialOrder.toPreorder.{u2} A (SemilatticeInf.toPartialOrder.{u2} A (Lattice.toSemilatticeInf.{u2} A (LinearOrder.toLattice.{u2} A _inst_4))))))], NoZeroDivisors.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_3))) (MulZeroClass.toHasZero.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (NonUnitalNonAssocSemiring.toMulZeroClass.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.nonUnitalNonAssocSemiring.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddRightCancelSemigroup.toAddSemigroup.{u2} A _inst_3)))))
but is expected to have type
  forall {R : Type.{u2}} {A : Type.{u1}} [_inst_1 : Semiring.{u2} R] [_inst_2 : NoZeroDivisors.{u2} R (NonUnitalNonAssocSemiring.toMul.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R _inst_1))) (MonoidWithZero.toZero.{u2} R (Semiring.toMonoidWithZero.{u2} R _inst_1))] [_inst_3 : AddRightCancelSemigroup.{u1} A] [_inst_4 : LinearOrder.{u1} A] [_inst_5 : CovariantClass.{u1, u1} A A (fun (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.587 : A) (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.589 : A) => HAdd.hAdd.{u1, u1, u1} A A A (instHAdd.{u1} A (AddSemigroup.toAdd.{u1} A (AddRightCancelSemigroup.toAddSemigroup.{u1} A _inst_3))) x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.587 x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.589) (fun (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.602 : A) (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.604 : A) => LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SemilatticeInf.toPartialOrder.{u1} A (Lattice.toSemilatticeInf.{u1} A (DistribLattice.toLattice.{u1} A (instDistribLattice.{u1} A _inst_4)))))) x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.602 x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.604)], NoZeroDivisors.{max u1 u2} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (AddMonoidAlgebra.hasMul.{u2, u1} R A _inst_1 (AddSemigroup.toAdd.{u1} A (AddRightCancelSemigroup.toAddSemigroup.{u1} A _inst_3))) (SemigroupWithZero.toZero.{max u2 u1} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (NonUnitalSemiring.toSemigroupWithZero.{max u2 u1} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (AddMonoidAlgebra.nonUnitalSemiring.{u2, u1} R A _inst_1 (AddRightCancelSemigroup.toAddSemigroup.{u1} A _inst_3))))
Case conversion may be inaccurate. Consider using '#align add_monoid_algebra.no_zero_divisors.of_left_ordered AddMonoidAlgebra.NoZeroDivisors.of_left_orderedₓ'. -/
/-- If `R` is a semiring with no non-trivial zero-divisors and `A` is a left-ordered add right
cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/
theorem NoZeroDivisors.of_left_ordered [NoZeroDivisors R] [AddRightCancelSemigroup A]
    [LinearOrder A] [CovariantClass A A (· + ·) (· < ·)] : NoZeroDivisors (AddMonoidAlgebra R A) :=
  ⟨fun f g fg => by
    contrapose! fg
    let gmin : A := g.support.min' (support_nonempty_iff.mpr fg.2)
    refine' support_nonempty_iff.mp _
    obtain ⟨a, ha, H⟩ :=
      right.exists_add_of_mem_support_single_mul gmin
        ((f * single gmin 1 : AddMonoidAlgebra R A).support.min'
          (by rw [support_mul_single] <;> simp [support_nonempty_iff.mpr fg.1]))
        (Finset.min'_mem _ _)
    refine' ⟨a + gmin, mem_support_iff.mpr _⟩
    rw [mul_apply_add_eq_mul_of_forall_ne _]
    · refine' mul_ne_zero _ _
      exacts[mem_support_iff.mp ha, mem_support_iff.mp (Finset.min'_mem _ _)]
    · rw [H]
      rintro b c bf cg (hb | hc) <;> refine' ne_of_gt _
      · refine' lt_of_lt_of_le (_ : _ < b + gmin) _
        · apply Finset.min'_lt_of_mem_erase_min'
          rw [← H]
          apply Finset.mem_erase_of_ne_of_mem
          · simpa only [Ne.def, add_left_inj]
          · rw [support_mul_single _ _ (fun y => by rw [mul_one] : ∀ y : R, y * 1 = 0 ↔ _)]
            simpa only [Finset.mem_map, addRightEmbedding_apply, add_left_inj, exists_prop,
              exists_eq_right]
        · haveI : CovariantClass A A (· + ·) (· ≤ ·) := Add.to_covariantClass_left A
          exact add_le_add_left (Finset.min'_le _ _ cg) _
      · refine' lt_of_le_of_lt (_ : _ ≤ b + gmin) _
        · apply Finset.min'_le
          rw [support_mul_single _ _ (fun y => by rw [mul_one] : ∀ y : R, y * 1 = 0 ↔ _)]
          simp only [bf, Finset.mem_map, addRightEmbedding_apply, add_left_inj, exists_prop,
            exists_eq_right]
        · refine' add_lt_add_left _ _
          exact Finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hc, cg⟩)⟩
#align add_monoid_algebra.no_zero_divisors.of_left_ordered AddMonoidAlgebra.NoZeroDivisors.of_left_ordered

/- warning: add_monoid_algebra.no_zero_divisors.of_right_ordered -> AddMonoidAlgebra.NoZeroDivisors.of_right_ordered is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {A : Type.{u2}} [_inst_1 : Semiring.{u1} R] [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))] [_inst_3 : AddLeftCancelSemigroup.{u2} A] [_inst_4 : LinearOrder.{u2} A] [_inst_5 : CovariantClass.{u2, u2} A A (Function.swap.{succ u2, succ u2, succ u2} A A (fun (ᾰ : A) (ᾰ : A) => A) (HAdd.hAdd.{u2, u2, u2} A A A (instHAdd.{u2} A (AddSemigroup.toHasAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_3))))) (LT.lt.{u2} A (Preorder.toLT.{u2} A (PartialOrder.toPreorder.{u2} A (SemilatticeInf.toPartialOrder.{u2} A (Lattice.toSemilatticeInf.{u2} A (LinearOrder.toLattice.{u2} A _inst_4))))))], NoZeroDivisors.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.hasMul.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_3))) (MulZeroClass.toHasZero.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (NonUnitalNonAssocSemiring.toMulZeroClass.{max u2 u1} (AddMonoidAlgebra.{u1, u2} R A _inst_1) (AddMonoidAlgebra.nonUnitalNonAssocSemiring.{u1, u2} R A _inst_1 (AddSemigroup.toHasAdd.{u2} A (AddLeftCancelSemigroup.toAddSemigroup.{u2} A _inst_3)))))
but is expected to have type
  forall {R : Type.{u2}} {A : Type.{u1}} [_inst_1 : Semiring.{u2} R] [_inst_2 : NoZeroDivisors.{u2} R (NonUnitalNonAssocSemiring.toMul.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R _inst_1))) (MonoidWithZero.toZero.{u2} R (Semiring.toMonoidWithZero.{u2} R _inst_1))] [_inst_3 : AddLeftCancelSemigroup.{u1} A] [_inst_4 : LinearOrder.{u1} A] [_inst_5 : CovariantClass.{u1, u1} A A (Function.swap.{succ u1, succ u1, succ u1} A A (fun (ᾰ : A) (ᾰ : A) => A) (fun (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1204 : A) (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1206 : A) => HAdd.hAdd.{u1, u1, u1} A A A (instHAdd.{u1} A (AddSemigroup.toAdd.{u1} A (AddLeftCancelSemigroup.toAddSemigroup.{u1} A _inst_3))) x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1204 x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1206)) (fun (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1219 : A) (x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1221 : A) => LT.lt.{u1} A (Preorder.toLT.{u1} A (PartialOrder.toPreorder.{u1} A (SemilatticeInf.toPartialOrder.{u1} A (Lattice.toSemilatticeInf.{u1} A (DistribLattice.toLattice.{u1} A (instDistribLattice.{u1} A _inst_4)))))) x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1219 x._@.Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors._hyg.1221)], NoZeroDivisors.{max u1 u2} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (AddMonoidAlgebra.hasMul.{u2, u1} R A _inst_1 (AddSemigroup.toAdd.{u1} A (AddLeftCancelSemigroup.toAddSemigroup.{u1} A _inst_3))) (SemigroupWithZero.toZero.{max u2 u1} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (NonUnitalSemiring.toSemigroupWithZero.{max u2 u1} (AddMonoidAlgebra.{u2, u1} R A _inst_1) (AddMonoidAlgebra.nonUnitalSemiring.{u2, u1} R A _inst_1 (AddLeftCancelSemigroup.toAddSemigroup.{u1} A _inst_3))))
Case conversion may be inaccurate. Consider using '#align add_monoid_algebra.no_zero_divisors.of_right_ordered AddMonoidAlgebra.NoZeroDivisors.of_right_orderedₓ'. -/
/-- If `R` is a semiring with no non-trivial zero-divisors and `A` is a right-ordered add left
cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/
theorem NoZeroDivisors.of_right_ordered [NoZeroDivisors R] [AddLeftCancelSemigroup A]
    [LinearOrder A] [CovariantClass A A (Function.swap (· + ·)) (· < ·)] :
    NoZeroDivisors (AddMonoidAlgebra R A) :=
  ⟨fun f g fg => by
    contrapose! fg
    let fmin : A := f.support.min' (support_nonempty_iff.mpr fg.1)
    refine' support_nonempty_iff.mp _
    obtain ⟨a, ha, H⟩ :=
      left.exists_add_of_mem_support_single_mul fmin
        ((single fmin 1 * g : AddMonoidAlgebra R A).support.min'
          (by rw [support_single_mul] <;> simp [support_nonempty_iff.mpr fg.2]))
        (Finset.min'_mem _ _)
    refine' ⟨fmin + a, mem_support_iff.mpr _⟩
    rw [mul_apply_add_eq_mul_of_forall_ne _]
    · refine' mul_ne_zero _ _
      exacts[mem_support_iff.mp (Finset.min'_mem _ _), mem_support_iff.mp ha]
    · rw [H]
      rintro b c bf cg (hb | hc) <;> refine' ne_of_gt _
      · refine' lt_of_le_of_lt (_ : _ ≤ fmin + c) _
        · apply Finset.min'_le
          rw [support_single_mul _ _ (fun y => by rw [one_mul] : ∀ y : R, 1 * y = 0 ↔ _)]
          simp only [cg, Finset.mem_map, addLeftEmbedding_apply, add_right_inj, exists_prop,
            exists_eq_right]
        · refine' add_lt_add_right _ _
          exact Finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hb, bf⟩)
      · refine' lt_of_lt_of_le (_ : _ < fmin + c) _
        · apply Finset.min'_lt_of_mem_erase_min'
          rw [← H]
          apply Finset.mem_erase_of_ne_of_mem
          · simpa only [Ne.def, add_right_inj]
          · rw [support_single_mul _ _ (fun y => by rw [one_mul] : ∀ y : R, 1 * y = 0 ↔ _)]
            simpa only [Finset.mem_map, addLeftEmbedding_apply, add_right_inj, exists_prop,
              exists_eq_right]
        · haveI : CovariantClass A A (Function.swap (· + ·)) (· ≤ ·) :=
            Add.to_covariantClass_right A
          exact add_le_add_right (Finset.min'_le _ _ bf) _⟩
#align add_monoid_algebra.no_zero_divisors.of_right_ordered AddMonoidAlgebra.NoZeroDivisors.of_right_ordered

end LeftOrRightOrderability

end AddMonoidAlgebra


import graphs.iso

/-
Proving equality on structures is a pain, so we should prove an extensionality
theorem.  Basically, it suffices for the respective vertex maps and edge maps to
be equal.

You will need to use cases to write out α and β, and then rewrite with
morphism.mk.inj_eq, which splits the equality of structures into separate goals.
-/
/- Lemma :
-/
lemma mor_ext {G H : graph} (α : G ↦ H) (β : G ↦ H) (hv : α.vertex_map = β.vertex_map) (he : α.edge_map = β.edge_map) : α = β :=
begin
  sorry,

end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Devon Tuma
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.polynomial.basic
import Mathlib.ring_theory.non_zero_divisors
import Mathlib.PostPort

universes u_3 u_4 u_1 u_2

namespace Mathlib

/-- `scale_roots p s` is a polynomial with root `r * s` for each root `r` of `p`. -/
def scale_roots {R : Type u_3} [comm_ring R] (p : polynomial R) (s : R) : polynomial R :=
  finsupp.on_finset (finsupp.support p) (fun (i : ℕ) => polynomial.coeff p i * s ^ (polynomial.nat_degree p - i)) sorry

@[simp] theorem coeff_scale_roots {R : Type u_3} [comm_ring R] (p : polynomial R) (s : R) (i : ℕ) : polynomial.coeff (scale_roots p s) i = polynomial.coeff p i * s ^ (polynomial.nat_degree p - i) :=
  rfl

theorem coeff_scale_roots_nat_degree {R : Type u_3} [comm_ring R] (p : polynomial R) (s : R) : polynomial.coeff (scale_roots p s) (polynomial.nat_degree p) = polynomial.leading_coeff p := sorry

@[simp] theorem zero_scale_roots {R : Type u_3} [comm_ring R] (s : R) : scale_roots 0 s = 0 := sorry

theorem scale_roots_ne_zero {R : Type u_3} [comm_ring R] {p : polynomial R} (hp : p ≠ 0) (s : R) : scale_roots p s ≠ 0 := sorry

theorem support_scale_roots_le {R : Type u_3} [comm_ring R] (p : polynomial R) (s : R) : finsupp.support (scale_roots p s) ≤ finsupp.support p := sorry

theorem support_scale_roots_eq {R : Type u_3} [comm_ring R] (p : polynomial R) {s : R} (hs : s ∈ non_zero_divisors R) : finsupp.support (scale_roots p s) = finsupp.support p := sorry

@[simp] theorem degree_scale_roots {R : Type u_3} [comm_ring R] (p : polynomial R) {s : R} : polynomial.degree (scale_roots p s) = polynomial.degree p := sorry

@[simp] theorem nat_degree_scale_roots {R : Type u_3} [comm_ring R] (p : polynomial R) (s : R) : polynomial.nat_degree (scale_roots p s) = polynomial.nat_degree p := sorry

theorem monic_scale_roots_iff {R : Type u_3} [comm_ring R] {p : polynomial R} (s : R) : polynomial.monic (scale_roots p s) ↔ polynomial.monic p := sorry

theorem scale_roots_eval₂_eq_zero {R : Type u_3} {S : Type u_4} [comm_ring R] [comm_ring S] {p : polynomial S} (f : S →+* R) {r : R} {s : S} (hr : polynomial.eval₂ f r p = 0) : polynomial.eval₂ f (coe_fn f s * r) (scale_roots p s) = 0 := sorry

theorem scale_roots_aeval_eq_zero {R : Type u_3} {S : Type u_4} [comm_ring R] [comm_ring S] [algebra S R] {p : polynomial S} {r : R} {s : S} (hr : coe_fn (polynomial.aeval r) p = 0) : coe_fn (polynomial.aeval (coe_fn (algebra_map S R) s * r)) (scale_roots p s) = 0 :=
  scale_roots_eval₂_eq_zero (algebra_map S R) hr

theorem scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero {A : Type u_1} {K : Type u_2} [integral_domain A] [field K] {p : polynomial A} {f : A →+* K} (hf : function.injective ⇑f) {r : A} {s : A} (hr : polynomial.eval₂ f (coe_fn f r / coe_fn f s) p = 0) (hs : s ∈ non_zero_divisors A) : polynomial.eval₂ f (coe_fn f r) (scale_roots p s) = 0 := sorry

theorem scale_roots_aeval_eq_zero_of_aeval_div_eq_zero {A : Type u_1} {K : Type u_2} [integral_domain A] [field K] [algebra A K] (inj : function.injective ⇑(algebra_map A K)) {p : polynomial A} {r : A} {s : A} (hr : coe_fn (polynomial.aeval (coe_fn (algebra_map A K) r / coe_fn (algebra_map A K) s)) p = 0) (hs : s ∈ non_zero_divisors A) : coe_fn (polynomial.aeval (coe_fn (algebra_map A K) r)) (scale_roots p s) = 0 :=
  scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero inj hr hs


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/

import data.fintype.basic
import computability.language
import tactic.norm_num

/-!
# Deterministic Finite Automata
This file contains the definition of a Deterministic Finite Automaton (DFA), a state machine which
determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set
in linear time.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true DFA's.
-/

universes u v

/-- A DFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`). -/
structure DFA (α : Type u) (σ : Type v) :=
(step : σ → α → σ)
(start : σ)
(accept : set σ)

namespace DFA

variables {α : Type u} {σ : Type v} (M : DFA α σ)

instance [inhabited σ] : inhabited (DFA α σ) :=
⟨DFA.mk (λ _ _, default σ) (default σ) ∅⟩

/-- `M.eval_from s x` evaluates `M` with input `x` starting from the state `s`. -/
def eval_from (start : σ) : list α → σ :=
list.foldl M.step start

/-- `M.eval x` evaluates `M` with input `x` starting from the state `M.start`. -/
def eval := M.eval_from M.start

/-- `M.accepts` is the language of `x` such that `M.eval x` is an accept state. -/
def accepts : language α :=
λ x, M.eval x ∈ M.accept

lemma mem_accepts (x : list α) : x ∈ M.accepts ↔ M.eval_from M.start x ∈ M.accept := by refl

lemma eval_from_of_append (start : σ) (x y : list α) :
  M.eval_from start (x ++ y) = M.eval_from (M.eval_from start x) y :=
x.foldl_append _ _ y

lemma eval_from_split [fintype σ] {x : list α} {s t : σ} (hlen : fintype.card σ ≤ x.length)
  (hx : M.eval_from s x = t) :
  ∃ q a b c,
  x = a ++ b ++ c ∧
  a.length + b.length ≤ fintype.card σ ∧
  b ≠ [] ∧
  M.eval_from s a = q ∧
  M.eval_from q b = q ∧
  M.eval_from q c = t :=
begin
  obtain ⟨n, m, hneq, heq⟩ := fintype.exists_ne_map_eq_of_card_lt
    (λ n : fin (fintype.card σ + 1), M.eval_from s (x.take n)) (by norm_num),
  wlog hle : (n : ℕ) ≤ m using n m,
  have hlt : (n : ℕ) < m := (ne.le_iff_lt hneq).mp hle,
  have hm : (m : ℕ) ≤ fintype.card σ := fin.is_le m,
  dsimp at heq,

  refine ⟨M.eval_from s ((x.take m).take n), (x.take m).take n, (x.take m).drop n, x.drop m,
    _, _, _, by refl, _⟩,

  { rw [list.take_append_drop, list.take_append_drop] },

  { simp only [list.length_drop, list.length_take],
    rw [min_eq_left (hm.trans hlen), min_eq_left hle, add_tsub_cancel_of_le hle],
    exact hm },

  { intro h,
    have hlen' := congr_arg list.length h,
    simp only [list.length_drop, list.length, list.length_take] at hlen',
    rw [min_eq_left, tsub_eq_zero_iff_le] at hlen',
    { apply hneq,
      apply le_antisymm,
      assumption' },
    exact hm.trans hlen, },

  have hq :
    M.eval_from (M.eval_from s ((x.take m).take n)) ((x.take m).drop n) =
      M.eval_from s ((x.take m).take n),
  { rw [list.take_take, min_eq_left hle, ←eval_from_of_append, heq, ←min_eq_left hle,
        ←list.take_take, min_eq_left hle, list.take_append_drop] },

  use hq,
  rwa [←hq, ←eval_from_of_append, ←eval_from_of_append, ←list.append_assoc, list.take_append_drop,
       list.take_append_drop]
end

lemma eval_from_of_pow {x y : list α} {s : σ} (hx : M.eval_from s x = s)
  (hy : y ∈ @language.star α {x}) : M.eval_from s y = s :=
begin
  rw language.mem_star at hy,
  rcases hy with ⟨ S, rfl, hS ⟩,
  induction S with a S ih,
  { refl },
  { have ha := hS a (list.mem_cons_self _ _),
    rw set.mem_singleton_iff at ha,
    rw [list.join, eval_from_of_append, ha, hx],
    apply ih,
    intros z hz,
    exact hS z (list.mem_cons_of_mem a hz) }
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card σ ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card σ ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl,
  use [a, b, c, hx, hlen, hnil],
  intros y hy,
  rw language.mem_mul at hy,
  rcases hy with ⟨ ab, c', hab, hc', rfl ⟩,
  rw language.mem_mul at hab,
  rcases hab with ⟨ a', b', ha', hb', rfl ⟩,
  rw set.mem_singleton_iff at ha' hc',
  substs ha' hc',
  have h := M.eval_from_of_pow hb hb',
  rwa [mem_accepts, eval_from_of_append, eval_from_of_append, h, hc]
end

end DFA