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

! This file was ported from Lean 3 source module topology.locally_constant.basic
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.SubsetProperties
import Mathlib.Topology.Connected
import Mathlib.Topology.ContinuousFunction.Basic
import Mathlib.Algebra.IndicatorFunction
import Mathlib.Tactic.FinCases
import Mathlib.Tactic.TFAE

/-!
# Locally constant functions

This file sets up the theory of locally constant function from a topological space to a type.

## Main definitions and constructions

* `IsLocallyConstant f` : a map `f : X → Y` where `X` is a topological space is locally
                            constant if every set in `Y` has an open preimage.
* `LocallyConstant X Y` : the type of locally constant maps from `X` to `Y`
* `LocallyConstant.map` : push-forward of locally constant maps
* `LocallyConstant.comap` : pull-back of locally constant maps

-/

variable {X Y Z α : Type _} [TopologicalSpace X]

open Set Filter

open Topology

/-- A function between topological spaces is locally constant if the preimage of any set is open. -/
def IsLocallyConstant (f : X → Y) : Prop :=
  ∀ s : Set Y, IsOpen (f ⁻¹' s)
#align is_locally_constant IsLocallyConstant

namespace IsLocallyConstant

open List in
protected theorem tfae (f : X → Y) :
    TFAE [IsLocallyConstant f,
      ∀ x, ∀ᶠ x' in 𝓝 x, f x' = f x,
      ∀ x, IsOpen { x' | f x' = f x },
      ∀ y, IsOpen (f ⁻¹' {y}),
      ∀ x, ∃ U : Set X, IsOpen U ∧ x ∈ U ∧ ∀ x' ∈ U, f x' = f x] := by
  tfae_have 1 → 4; exact fun h y => h {y}
  tfae_have 4 → 3; exact fun h x => h (f x)
  tfae_have 3 → 2; exact fun h x => IsOpen.mem_nhds (h x) rfl
  tfae_have 2 → 5
  · intro h x
    rcases mem_nhds_iff.1 (h x) with ⟨U, eq, hU, hx⟩
    exact ⟨U, hU, hx, eq⟩
  tfae_have 5 → 1
  · intro h s
    refine' isOpen_iff_forall_mem_open.2 fun x hx => _
    rcases h x with ⟨U, hU, hxU, eq⟩
    exact ⟨U, fun x' hx' => mem_preimage.2 <| (eq x' hx').symm ▸ hx, hU, hxU⟩
  tfae_finish
#align is_locally_constant.tfae IsLocallyConstant.tfae

@[nontriviality]
theorem of_discrete [DiscreteTopology X] (f : X → Y) : IsLocallyConstant f := fun _ =>
  isOpen_discrete _
#align is_locally_constant.of_discrete IsLocallyConstant.of_discrete

theorem isOpen_fiber {f : X → Y} (hf : IsLocallyConstant f) (y : Y) : IsOpen { x | f x = y } :=
  hf {y}
#align is_locally_constant.is_open_fiber IsLocallyConstant.isOpen_fiber

theorem isClosed_fiber {f : X → Y} (hf : IsLocallyConstant f) (y : Y) : IsClosed { x | f x = y } :=
  ⟨hf ({y}ᶜ)⟩
#align is_locally_constant.is_closed_fiber IsLocallyConstant.isClosed_fiber

theorem isClopen_fiber {f : X → Y} (hf : IsLocallyConstant f) (y : Y) : IsClopen { x | f x = y } :=
  ⟨isOpen_fiber hf _, isClosed_fiber hf _⟩
#align is_locally_constant.is_clopen_fiber IsLocallyConstant.isClopen_fiber

theorem iff_exists_open (f : X → Y) :
    IsLocallyConstant f ↔ ∀ x, ∃ U : Set X, IsOpen U ∧ x ∈ U ∧ ∀ x' ∈ U, f x' = f x :=
  (IsLocallyConstant.tfae f).out 0 4
#align is_locally_constant.iff_exists_open IsLocallyConstant.iff_exists_open

theorem iff_eventually_eq (f : X → Y) : IsLocallyConstant f ↔ ∀ x, ∀ᶠ y in 𝓝 x, f y = f x :=
  (IsLocallyConstant.tfae f).out 0 1
#align is_locally_constant.iff_eventually_eq IsLocallyConstant.iff_eventually_eq

theorem exists_open {f : X → Y} (hf : IsLocallyConstant f) (x : X) :
    ∃ U : Set X, IsOpen U ∧ x ∈ U ∧ ∀ x' ∈ U, f x' = f x :=
  (iff_exists_open f).1 hf x
#align is_locally_constant.exists_open IsLocallyConstant.exists_open

protected theorem eventually_eq {f : X → Y} (hf : IsLocallyConstant f) (x : X) :
    ∀ᶠ y in 𝓝 x, f y = f x :=
  (iff_eventually_eq f).1 hf x
#align is_locally_constant.eventually_eq IsLocallyConstant.eventually_eq

-- porting note: new lemma
theorem iff_isOpen_fiber_apply {f : X → Y} : IsLocallyConstant f ↔ ∀ x, IsOpen (f ⁻¹' {f x}) :=
  (IsLocallyConstant.tfae f).out 0 2

-- porting note: new lemma
theorem iff_isOpen_fiber {f : X → Y} : IsLocallyConstant f ↔ ∀ y, IsOpen (f ⁻¹' {y}) :=
  (IsLocallyConstant.tfae f).out 0 3

protected theorem continuous [TopologicalSpace Y] {f : X → Y} (hf : IsLocallyConstant f) :
    Continuous f :=
  ⟨fun _ _ => hf _⟩
#align is_locally_constant.continuous IsLocallyConstant.continuous

theorem iff_continuous {_ : TopologicalSpace Y} [DiscreteTopology Y] (f : X → Y) :
    IsLocallyConstant f ↔ Continuous f :=
  ⟨IsLocallyConstant.continuous, fun h s => h.isOpen_preimage s (isOpen_discrete _)⟩
#align is_locally_constant.iff_continuous IsLocallyConstant.iff_continuous

theorem of_constant (f : X → Y) (h : ∀ x y, f x = f y) : IsLocallyConstant f :=
  (iff_eventually_eq f).2 fun _ => eventually_of_forall fun _ => h _ _
#align is_locally_constant.of_constant IsLocallyConstant.of_constant

protected theorem const (y : Y) : IsLocallyConstant (Function.const X y) :=
  of_constant _ fun _ _ => rfl
#align is_locally_constant.const IsLocallyConstant.const

protected theorem comp {f : X → Y} (hf : IsLocallyConstant f) (g : Y → Z) :
    IsLocallyConstant (g ∘ f) := fun s => by
  rw [Set.preimage_comp]
  exact hf _
#align is_locally_constant.comp IsLocallyConstant.comp

theorem prod_mk {Y'} {f : X → Y} {f' : X → Y'} (hf : IsLocallyConstant f)
    (hf' : IsLocallyConstant f') : IsLocallyConstant fun x => (f x, f' x) :=
  (iff_eventually_eq _).2 fun x =>
    (hf.eventually_eq x).mp <| (hf'.eventually_eq x).mono fun _ hf' hf => Prod.ext hf hf'
#align is_locally_constant.prod_mk IsLocallyConstant.prod_mk

theorem comp₂ {Y₁ Y₂ Z : Type _} {f : X → Y₁} {g : X → Y₂} (hf : IsLocallyConstant f)
    (hg : IsLocallyConstant g) (h : Y₁ → Y₂ → Z) : IsLocallyConstant fun x => h (f x) (g x) :=
  (hf.prod_mk hg).comp fun x : Y₁ × Y₂ => h x.1 x.2
#align is_locally_constant.comp₂ IsLocallyConstant.comp₂

theorem comp_continuous [TopologicalSpace Y] {g : Y → Z} {f : X → Y} (hg : IsLocallyConstant g)
    (hf : Continuous f) : IsLocallyConstant (g ∘ f) := fun s => by
  rw [Set.preimage_comp]
  exact hf.isOpen_preimage _ (hg _)
#align is_locally_constant.comp_continuous IsLocallyConstant.comp_continuous

/-- A locally constant function is constant on any preconnected set. -/
theorem apply_eq_of_isPreconnected {f : X → Y} (hf : IsLocallyConstant f) {s : Set X}
    (hs : IsPreconnected s) {x y : X} (hx : x ∈ s) (hy : y ∈ s) : f x = f y := by
  let U := f ⁻¹' {f y}
  suffices : x ∉ Uᶜ; exact Classical.not_not.1 this
  intro hxV
  specialize hs U (Uᶜ) (hf {f y}) (hf ({f y}ᶜ)) _ ⟨y, ⟨hy, rfl⟩⟩ ⟨x, ⟨hx, hxV⟩⟩
  · simp only [union_compl_self, subset_univ]
  · simp only [inter_empty, Set.not_nonempty_empty, inter_compl_self] at hs
#align is_locally_constant.apply_eq_of_is_preconnected IsLocallyConstant.apply_eq_of_isPreconnected

theorem apply_eq_of_preconnectedSpace [PreconnectedSpace X] {f : X → Y} (hf : IsLocallyConstant f)
    (x y : X) : f x = f y :=
  hf.apply_eq_of_isPreconnected isPreconnected_univ trivial trivial
#align is_locally_constant.apply_eq_of_preconnected_space IsLocallyConstant.apply_eq_of_preconnectedSpace

theorem eq_const [PreconnectedSpace X] {f : X → Y} (hf : IsLocallyConstant f) (x : X) :
    f = Function.const X (f x) :=
  funext fun y => hf.apply_eq_of_preconnectedSpace y x
#align is_locally_constant.eq_const IsLocallyConstant.eq_const

theorem exists_eq_const [PreconnectedSpace X] [Nonempty Y] {f : X → Y} (hf : IsLocallyConstant f) :
    ∃ y, f = Function.const X y := by
  cases' isEmpty_or_nonempty X with h h
  · exact ⟨Classical.arbitrary Y, funext <| h.elim⟩
  · exact ⟨f (Classical.arbitrary X), hf.eq_const _⟩
#align is_locally_constant.exists_eq_const IsLocallyConstant.exists_eq_const

theorem iff_is_const [PreconnectedSpace X] {f : X → Y} : IsLocallyConstant f ↔ ∀ x y, f x = f y :=
  ⟨fun h _ _ => h.apply_eq_of_isPreconnected isPreconnected_univ trivial trivial, of_constant _⟩
#align is_locally_constant.iff_is_const IsLocallyConstant.iff_is_const

theorem range_finite [CompactSpace X] {f : X → Y} (hf : IsLocallyConstant f) :
    (Set.range f).Finite := by
  letI : TopologicalSpace Y := ⊥; haveI := discreteTopology_bot Y
  exact (isCompact_range hf.continuous).finite_of_discrete
#align is_locally_constant.range_finite IsLocallyConstant.range_finite

@[to_additive]
theorem one [One Y] : IsLocallyConstant (1 : X → Y) := IsLocallyConstant.const 1
#align is_locally_constant.one IsLocallyConstant.one
#align is_locally_constant.zero IsLocallyConstant.zero

@[to_additive]
theorem inv [Inv Y] ⦃f : X → Y⦄ (hf : IsLocallyConstant f) : IsLocallyConstant f⁻¹ :=
  hf.comp fun x => x⁻¹
#align is_locally_constant.inv IsLocallyConstant.inv
#align is_locally_constant.neg IsLocallyConstant.neg

@[to_additive]
theorem mul [Mul Y] ⦃f g : X → Y⦄ (hf : IsLocallyConstant f) (hg : IsLocallyConstant g) :
    IsLocallyConstant (f * g) :=
  hf.comp₂ hg (· * ·)
#align is_locally_constant.mul IsLocallyConstant.mul
#align is_locally_constant.add IsLocallyConstant.add

@[to_additive]
theorem div [Div Y] ⦃f g : X → Y⦄ (hf : IsLocallyConstant f) (hg : IsLocallyConstant g) :
    IsLocallyConstant (f / g) :=
  hf.comp₂ hg (· / ·)
#align is_locally_constant.div IsLocallyConstant.div
#align is_locally_constant.sub IsLocallyConstant.sub

/-- If a composition of a function `f` followed by an injection `g` is locally
constant, then the locally constant property descends to `f`. -/
theorem desc {α β : Type _} (f : X → α) (g : α → β) (h : IsLocallyConstant (g ∘ f))
    (inj : Function.Injective g) : IsLocallyConstant f := fun s => by
  rw [← preimage_image_eq s inj, preimage_preimage]
  exact h (g '' s)
#align is_locally_constant.desc IsLocallyConstant.desc

theorem of_constant_on_connected_components [LocallyConnectedSpace X] {f : X → Y}
    (h : ∀ x, ∀ y ∈ connectedComponent x, f y = f x) : IsLocallyConstant f :=
  (iff_exists_open _).2 fun x =>
    ⟨connectedComponent x, isOpen_connectedComponent, mem_connectedComponent, h x⟩
#align is_locally_constant.of_constant_on_connected_components IsLocallyConstant.of_constant_on_connected_components

theorem of_constant_on_preconnected_clopens [LocallyConnectedSpace X] {f : X → Y}
    (h : ∀ U : Set X, IsPreconnected U → IsClopen U → ∀ x ∈ U, ∀ y ∈ U, f y = f x) :
    IsLocallyConstant f :=
  of_constant_on_connected_components fun x =>
    h (connectedComponent x) isPreconnected_connectedComponent isClopen_connectedComponent x
      mem_connectedComponent
#align is_locally_constant.of_constant_on_preconnected_clopens IsLocallyConstant.of_constant_on_preconnected_clopens

end IsLocallyConstant

/-- A (bundled) locally constant function from a topological space `X` to a type `Y`. -/
structure LocallyConstant (X Y : Type _) [TopologicalSpace X] where
  /-- The underlying function. -/
  protected toFun : X → Y
  /-- The map is locally constant. -/
  protected isLocallyConstant : IsLocallyConstant toFun
#align locally_constant LocallyConstant

namespace LocallyConstant

instance [Inhabited Y] : Inhabited (LocallyConstant X Y) :=
  ⟨⟨_, IsLocallyConstant.const default⟩⟩

instance : FunLike (LocallyConstant X Y) X (fun _ => Y) where
  coe := LocallyConstant.toFun
  coe_injective' := by rintro ⟨_, _⟩ ⟨_, _⟩ _; congr

/-- See Note [custom simps projections]. -/
def Simps.apply (f : LocallyConstant X Y) : X → Y := f

initialize_simps_projections LocallyConstant (toFun → apply)

@[simp]
theorem toFun_eq_coe (f : LocallyConstant X Y) : f.toFun = f :=
  rfl
#align locally_constant.to_fun_eq_coe LocallyConstant.toFun_eq_coe

@[simp]
theorem coe_mk (f : X → Y) (h) : ⇑(⟨f, h⟩ : LocallyConstant X Y) = f :=
  rfl
#align locally_constant.coe_mk LocallyConstant.coe_mk

theorem congr_fun {f g : LocallyConstant X Y} (h : f = g) (x : X) : f x = g x :=
  FunLike.congr_fun h x
#align locally_constant.congr_fun LocallyConstant.congr_fun

theorem congr_arg (f : LocallyConstant X Y) {x y : X} (h : x = y) : f x = f y :=
  FunLike.congr_arg f h
#align locally_constant.congr_arg LocallyConstant.congr_arg

theorem coe_injective : @Function.Injective (LocallyConstant X Y) (X → Y) (↑) := fun _ _ =>
  FunLike.ext'
#align locally_constant.coe_injective LocallyConstant.coe_injective

@[norm_cast]

@[ext]
theorem ext ⦃f g : LocallyConstant X Y⦄ (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align locally_constant.ext LocallyConstant.ext

theorem ext_iff {f g : LocallyConstant X Y} : f = g ↔ ∀ x, f x = g x := FunLike.ext_iff
#align locally_constant.ext_iff LocallyConstant.ext_iff

section CodomainTopologicalSpace

variable [TopologicalSpace Y] (f : LocallyConstant X Y)

protected theorem continuous : Continuous f :=
  f.isLocallyConstant.continuous
#align locally_constant.continuous LocallyConstant.continuous

/-- We can turn a locally-constant function into a bundled `ContinuousMap`. -/
@[coe] def toContinuousMap : C(X, Y) :=
  ⟨f, f.continuous⟩
#align locally_constant.to_continuous_map LocallyConstant.toContinuousMap

/-- As a shorthand, `LocallyConstant.toContinuousMap` is available as a coercion -/
instance : Coe (LocallyConstant X Y) C(X, Y) := ⟨toContinuousMap⟩

-- porting note: became a syntatic `rfl`
#noalign locally_constant.to_continuous_map_eq_coe

@[simp] theorem coe_continuousMap : ((f : C(X, Y)) : X → Y) = (f : X → Y) := rfl
#align locally_constant.coe_continuous_map LocallyConstant.coe_continuousMap

theorem toContinuousMap_injective :
    Function.Injective (toContinuousMap : LocallyConstant X Y → C(X, Y)) := fun _ _ h =>
  ext (ContinuousMap.congr_fun h)
#align locally_constant.to_continuous_map_injective LocallyConstant.toContinuousMap_injective

end CodomainTopologicalSpace

/-- The constant locally constant function on `X` with value `y : Y`. -/
def const (X : Type _) {Y : Type _} [TopologicalSpace X] (y : Y) : LocallyConstant X Y :=
  ⟨Function.const X y, IsLocallyConstant.const _⟩
#align locally_constant.const LocallyConstant.const

@[simp]
theorem coe_const (y : Y) : (const X y : X → Y) = Function.const X y :=
  rfl
#align locally_constant.coe_const LocallyConstant.coe_const

/-- The locally constant function to `Fin 2` associated to a clopen set. -/
def ofClopen {X : Type _} [TopologicalSpace X] {U : Set X} [∀ x, Decidable (x ∈ U)]
    (hU : IsClopen U) : LocallyConstant X (Fin 2) where
  toFun x := if x ∈ U then 0 else 1
  isLocallyConstant := by
    refine IsLocallyConstant.iff_isOpen_fiber.2 <| Fin.forall_fin_two.2 ⟨?_, ?_⟩
    · convert hU.1 using 1
      ext
      simp only [mem_singleton_iff, Fin.one_eq_zero_iff, mem_preimage, ite_eq_left_iff,
        Nat.succ_succ_ne_one]
      tauto
    · rw [← isClosed_compl_iff]
      convert hU.2
      ext
      simp
#align locally_constant.of_clopen LocallyConstant.ofClopen

@[simp]
theorem ofClopen_fiber_zero {X : Type _} [TopologicalSpace X] {U : Set X} [∀ x, Decidable (x ∈ U)]
    (hU : IsClopen U) : ofClopen hU ⁻¹' ({0} : Set (Fin 2)) = U := by
  ext
  simp only [ofClopen, mem_singleton_iff, Fin.one_eq_zero_iff, coe_mk, mem_preimage,
    ite_eq_left_iff, Nat.succ_succ_ne_one]
  tauto
#align locally_constant.of_clopen_fiber_zero LocallyConstant.ofClopen_fiber_zero

@[simp]
theorem ofClopen_fiber_one {X : Type _} [TopologicalSpace X] {U : Set X} [∀ x, Decidable (x ∈ U)]
    (hU : IsClopen U) : ofClopen hU ⁻¹' ({1} : Set (Fin 2)) = Uᶜ := by
  ext
  simp only [ofClopen, mem_singleton_iff, coe_mk, Fin.zero_eq_one_iff, mem_preimage,
    ite_eq_right_iff, mem_compl_iff, Nat.succ_succ_ne_one]
#align locally_constant.of_clopen_fiber_one LocallyConstant.ofClopen_fiber_one

theorem locallyConstant_eq_of_fiber_zero_eq {X : Type _} [TopologicalSpace X]
    (f g : LocallyConstant X (Fin 2)) (h : f ⁻¹' ({0} : Set (Fin 2)) = g ⁻¹' {0}) : f = g := by
  simp only [Set.ext_iff, mem_singleton_iff, mem_preimage] at h
  ext1 x
  exact Fin.fin_two_eq_of_eq_zero_iff (h x)
#align locally_constant.locally_constant_eq_of_fiber_zero_eq LocallyConstant.locallyConstant_eq_of_fiber_zero_eq

theorem range_finite [CompactSpace X] (f : LocallyConstant X Y) : (Set.range f).Finite :=
  f.isLocallyConstant.range_finite
#align locally_constant.range_finite LocallyConstant.range_finite

theorem apply_eq_of_isPreconnected (f : LocallyConstant X Y) {s : Set X} (hs : IsPreconnected s)
    {x y : X} (hx : x ∈ s) (hy : y ∈ s) : f x = f y :=
  f.isLocallyConstant.apply_eq_of_isPreconnected hs hx hy
#align locally_constant.apply_eq_of_is_preconnected LocallyConstant.apply_eq_of_isPreconnected

theorem apply_eq_of_preconnectedSpace [PreconnectedSpace X] (f : LocallyConstant X Y) (x y : X) :
    f x = f y :=
  f.isLocallyConstant.apply_eq_of_isPreconnected isPreconnected_univ trivial trivial
#align locally_constant.apply_eq_of_preconnected_space LocallyConstant.apply_eq_of_preconnectedSpace

theorem eq_const [PreconnectedSpace X] (f : LocallyConstant X Y) (x : X) : f = const X (f x) :=
  ext fun _ => apply_eq_of_preconnectedSpace f _ _
#align locally_constant.eq_const LocallyConstant.eq_const

theorem exists_eq_const [PreconnectedSpace X] [Nonempty Y] (f : LocallyConstant X Y) :
    ∃ y, f = const X y := by
  rcases Classical.em (Nonempty X) with (⟨⟨x⟩⟩ | hX)
  · exact ⟨f x, f.eq_const x⟩
  · exact ⟨Classical.arbitrary Y, ext fun x => (hX ⟨x⟩).elim⟩
#align locally_constant.exists_eq_const LocallyConstant.exists_eq_const

/-- Push forward of locally constant maps under any map, by post-composition. -/
def map (f : Y → Z) (g : LocallyConstant X Y) : LocallyConstant X Z :=
  ⟨f ∘ g, g.isLocallyConstant.comp f⟩
#align locally_constant.map LocallyConstant.map

@[simp]
theorem map_apply (f : Y → Z) (g : LocallyConstant X Y) : ⇑(map f g) = f ∘ g :=
  rfl
#align locally_constant.map_apply LocallyConstant.map_apply

@[simp]
theorem map_id : @map X Y Y _ id = id := rfl
#align locally_constant.map_id LocallyConstant.map_id

@[simp]
theorem map_comp {Y₁ Y₂ Y₃ : Type _} (g : Y₂ → Y₃) (f : Y₁ → Y₂) :
    @map X _ _ _ g ∘ map f = map (g ∘ f) := rfl
#align locally_constant.map_comp LocallyConstant.map_comp

/-- Given a locally constant function to `α → β`, construct a family of locally constant
functions with values in β indexed by α. -/
def flip {X α β : Type _} [TopologicalSpace X] (f : LocallyConstant X (α → β)) (a : α) :
    LocallyConstant X β :=
  f.map fun f => f a
#align locally_constant.flip LocallyConstant.flip

/-- If α is finite, this constructs a locally constant function to `α → β` given a
family of locally constant functions with values in β indexed by α. -/
def unflip {X α β : Type _} [Finite α] [TopologicalSpace X] (f : α → LocallyConstant X β) :
    LocallyConstant X (α → β) where
  toFun x a := f a x
  isLocallyConstant := IsLocallyConstant.iff_isOpen_fiber.2 <| fun g => by
    have : (fun (x : X) (a : α) => f a x) ⁻¹' {g} = ⋂ a : α, f a ⁻¹' {g a} := by
      ext; simp [Function.funext_iff]
    rw [this]
    exact isOpen_interᵢ fun a => (f a).isLocallyConstant _
#align locally_constant.unflip LocallyConstant.unflip

@[simp]
theorem unflip_flip {X α β : Type _} [Finite α] [TopologicalSpace X]
    (f : LocallyConstant X (α → β)) : unflip f.flip = f := rfl
#align locally_constant.unflip_flip LocallyConstant.unflip_flip

@[simp]
theorem flip_unflip {X α β : Type _} [Finite α] [TopologicalSpace X]
    (f : α → LocallyConstant X β) : (unflip f).flip = f := rfl
#align locally_constant.flip_unflip LocallyConstant.flip_unflip

section Comap

open Classical

variable [TopologicalSpace Y]

/-- Pull back of locally constant maps under any map, by pre-composition.

This definition only makes sense if `f` is continuous,
in which case it sends locally constant functions to their precomposition with `f`.
See also `LocallyConstant.coe_comap`.

TODO: take `f : C(X, Y)` as an argument? Or we actually use it for discontinuous `f`? -/
noncomputable def comap (f : X → Y) : LocallyConstant Y Z → LocallyConstant X Z :=
  if hf : Continuous f then fun g => ⟨g ∘ f, g.isLocallyConstant.comp_continuous hf⟩
  else by
    by_cases H : Nonempty X
    · intro g
      exact const X (g <| f <| Classical.arbitrary X)
    · refine fun _ => ⟨fun x => (H ⟨x⟩).elim, fun s => ?_⟩
      rw [isOpen_iff_nhds]
      intro x
      exact (H ⟨x⟩).elim
#align locally_constant.comap LocallyConstant.comap

@[simp]
theorem coe_comap (f : X → Y) (g : LocallyConstant Y Z) (hf : Continuous f) :
    ⇑(comap f g) = g ∘ f := by
  rw [comap, dif_pos hf]
  rfl
#align locally_constant.coe_comap LocallyConstant.coe_comap

@[simp]
theorem comap_id : @comap X X Z _ _ id = id := by
  ext
  simp only [continuous_id, id.def, Function.comp.right_id, coe_comap]
#align locally_constant.comap_id LocallyConstant.comap_id

theorem comap_comp [TopologicalSpace Z] (f : X → Y) (g : Y → Z) (hf : Continuous f)
    (hg : Continuous g) : @comap _ _ α _ _ f ∘ comap g = comap (g ∘ f) := by
  ext
  rw [Function.comp_apply]
  simp only [hf, hg, hg.comp hf, coe_comap]; rfl
#align locally_constant.comap_comp LocallyConstant.comap_comp

theorem comap_const (f : X → Y) (y : Y) (h : ∀ x, f x = y) :
    (comap f : LocallyConstant Y Z → LocallyConstant X Z) = fun g =>
      ⟨fun _ => g y, IsLocallyConstant.const _⟩ := by
  ext; rw [coe_comap]
  · simp only [h, coe_mk, Function.comp_apply]
  · rw [show f = fun _ => y by ext; apply h]
    exact continuous_const
#align locally_constant.comap_const LocallyConstant.comap_const

end Comap

section Desc

/-- If a locally constant function factors through an injection, then it factors through a locally
constant function. -/
def desc {X α β : Type _} [TopologicalSpace X] {g : α → β} (f : X → α) (h : LocallyConstant X β)
    (cond : g ∘ f = h) (inj : Function.Injective g) : LocallyConstant X α where
  toFun := f
  isLocallyConstant := IsLocallyConstant.desc _ g (cond.symm ▸ h.isLocallyConstant) inj
#align locally_constant.desc LocallyConstant.desc

@[simp]
theorem coe_desc {X α β : Type _} [TopologicalSpace X] (f : X → α) (g : α → β)
    (h : LocallyConstant X β) (cond : g ∘ f = h) (inj : Function.Injective g) :
    ⇑(desc f h cond inj) = f :=
  rfl
#align locally_constant.coe_desc LocallyConstant.coe_desc

end Desc

section Indicator

variable {R : Type _} [One R] {U : Set X} (f : LocallyConstant X R)

open Classical

/-- Given a clopen set `U` and a locally constant function `f`, `LocallyConstant.mulIndicator`
  returns the locally constant function that is `f` on `U` and `1` otherwise. -/
@[to_additive (attr := simps) "Given a clopen set `U` and a locally constant function `f`,
  `locally_constant.indicator` returns the locally constant function that is `f` on `U` and `0`
  otherwise. "]
noncomputable def mulIndicator (hU : IsClopen U) : LocallyConstant X R where
  toFun := Set.mulIndicator U f
  isLocallyConstant := fun s => by
    rw [mulIndicator_preimage, Set.ite, Set.diff_eq]
    exact ((f.2 s).inter hU.isOpen).union ((IsLocallyConstant.const 1 s).inter hU.compl.isOpen)
#align locally_constant.mul_indicator LocallyConstant.mulIndicator
#align locally_constant.indicator LocallyConstant.indicator

variable (a : X)

@[to_additive]
theorem mulIndicator_apply_eq_if (hU : IsClopen U) :
    mulIndicator f hU a = if a ∈ U then f a else 1 :=
  Set.mulIndicator_apply U f a
#align locally_constant.mul_indicator_apply_eq_if LocallyConstant.mulIndicator_apply_eq_if
#align locally_constant.indicator_apply_eq_if LocallyConstant.indicator_apply_eq_if

variable {a}

@[to_additive]
theorem mulIndicator_of_mem (hU : IsClopen U) (h : a ∈ U) : f.mulIndicator hU a = f a :=
  Set.mulIndicator_of_mem h _
#align locally_constant.mul_indicator_of_mem LocallyConstant.mulIndicator_of_mem
#align locally_constant.indicator_of_mem LocallyConstant.indicator_of_mem

@[to_additive]
theorem mulIndicator_of_not_mem (hU : IsClopen U) (h : a ∉ U) : f.mulIndicator hU a = 1 :=
  Set.mulIndicator_of_not_mem h _
#align locally_constant.mul_indicator_of_not_mem LocallyConstant.mulIndicator_of_not_mem
#align locally_constant.indicator_of_not_mem LocallyConstant.indicator_of_not_mem

end Indicator

end LocallyConstant


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.divisibility
import Mathlib.data.set.basic
import Mathlib.PostPort

universes u_1 l x u v u_2 w

namespace Mathlib

/-!
# Properties and homomorphisms of semirings and rings

This file proves simple properties of semirings, rings and domains and their unit groups. It also
defines bundled homomorphisms of semirings and rings. As with monoid and groups, we use the same
structure `ring_hom a β`, a.k.a. `α →+* β`, for both homomorphism types.

The unbundled homomorphisms are defined in `deprecated/ring`. They are deprecated and the plan is to
slowly remove them from mathlib.

## Main definitions

ring_hom, nonzero, domain, integral_domain

## Notations

→+* for bundled ring homs (also use for semiring homs)

## Implementation notes

There's a coercion from bundled homs to fun, and the canonical
notation is to use the bundled hom as a function via this coercion.

There is no `semiring_hom` -- the idea is that `ring_hom` is used.
The constructor for a `ring_hom` between semirings needs a proof of `map_zero`, `map_one` and
`map_add` as well as `map_mul`; a separate constructor `ring_hom.mk'` will construct ring homs
between rings from monoid homs given only a proof that addition is preserved.

## Tags

`ring_hom`, `semiring_hom`, `semiring`, `comm_semiring`, `ring`, `comm_ring`, `domain`,
`integral_domain`, `nonzero`, `units`
-/

/-!
### `distrib` class
-/

/-- A typeclass stating that multiplication is left and right distributive
over addition. -/
class distrib (R : Type u_1)
extends Mul R, Add R
where
  left_distrib : ∀ (a b c : R), a * (b + c) = a * b + a * c
  right_distrib : ∀ (a b c : R), (a + b) * c = a * c + b * c

theorem left_distrib {R : Type x} [distrib R] (a : R) (b : R) (c : R) : a * (b + c) = a * b + a * c :=
  distrib.left_distrib a b c

theorem mul_add {R : Type x} [distrib R] (a : R) (b : R) (c : R) : a * (b + c) = a * b + a * c :=
  left_distrib

theorem right_distrib {R : Type x} [distrib R] (a : R) (b : R) (c : R) : (a + b) * c = a * c + b * c :=
  distrib.right_distrib a b c

theorem add_mul {R : Type x} [distrib R] (a : R) (b : R) (c : R) : (a + b) * c = a * c + b * c :=
  right_distrib

/-- Pullback a `distrib` instance along an injective function. -/
protected def function.injective.distrib {R : Type x} {S : Type u_1} [Mul R] [Add R] [distrib S] (f : R → S) (hf : function.injective f) (add : ∀ (x y : R), f (x + y) = f x + f y) (mul : ∀ (x y : R), f (x * y) = f x * f y) : distrib R :=
  distrib.mk Mul.mul Add.add sorry sorry

/-- Pushforward a `distrib` instance along a surjective function. -/
protected def function.surjective.distrib {R : Type x} {S : Type u_1} [distrib R] [Add S] [Mul S] (f : R → S) (hf : function.surjective f) (add : ∀ (x y : R), f (x + y) = f x + f y) (mul : ∀ (x y : R), f (x * y) = f x * f y) : distrib S :=
  distrib.mk Mul.mul Add.add sorry sorry

/-!
### Semirings
-/

/-- A semiring is a type with the following structures: additive commutative monoid
(`add_comm_monoid`), multiplicative monoid (`monoid`), distributive laws (`distrib`), and
multiplication by zero law (`mul_zero_class`). The actual definition extends `monoid_with_zero`
instead of `monoid` and `mul_zero_class`. -/
class semiring (α : Type u)
extends monoid_with_zero α, distrib α, add_comm_monoid α
where

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.injective.semiring {α : Type u} {β : Type v} [semiring α] [HasZero β] [HasOne β] [Add β] [Mul β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) : semiring β :=
  semiring.mk add_comm_monoid.add sorry monoid_with_zero.zero sorry sorry sorry monoid_with_zero.mul sorry
    monoid_with_zero.one sorry sorry sorry sorry sorry sorry

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.surjective.semiring {α : Type u} {β : Type v} [semiring α] [HasZero β] [HasOne β] [Add β] [Mul β] (f : α → β) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) : semiring β :=
  semiring.mk add_comm_monoid.add sorry monoid_with_zero.zero sorry sorry sorry monoid_with_zero.mul sorry
    monoid_with_zero.one sorry sorry sorry sorry sorry sorry

theorem one_add_one_eq_two {α : Type u} [semiring α] : 1 + 1 = bit0 1 := sorry

theorem two_mul {α : Type u} [semiring α] (n : α) : bit0 1 * n = n + n := sorry

theorem distrib_three_right {α : Type u} [semiring α] (a : α) (b : α) (c : α) (d : α) : (a + b + c) * d = a * d + b * d + c * d := sorry

theorem mul_two {α : Type u} [semiring α] (n : α) : n * bit0 1 = n + n := sorry

theorem bit0_eq_two_mul {α : Type u} [semiring α] (n : α) : bit0 n = bit0 1 * n :=
  Eq.symm (two_mul n)

theorem add_ite {α : Type u_1} [Add α] (P : Prop) [Decidable P] (a : α) (b : α) (c : α) : a + ite P b c = ite P (a + b) (a + c) := sorry

@[simp] theorem ite_mul {α : Type u_1} [Mul α] (P : Prop) [Decidable P] (a : α) (b : α) (c : α) : ite P a b * c = ite P (a * c) (b * c) := sorry

-- We make `mul_ite` and `ite_mul` simp lemmas,

-- but not `add_ite` or `ite_add`.

-- The problem we're trying to avoid is dealing with

-- summations of the form `∑ x in s, (f x + ite P 1 0)`,

-- in which `add_ite` followed by `sum_ite` would needlessly slice up

-- the `f x` terms according to whether `P` holds at `x`.

-- There doesn't appear to be a corresponding difficulty so far with

-- `mul_ite` and `ite_mul`.

@[simp] theorem mul_boole {α : Type u_1} [semiring α] (P : Prop) [Decidable P] (a : α) : a * ite P 1 0 = ite P a 0 := sorry

@[simp] theorem boole_mul {α : Type u_1} [semiring α] (P : Prop) [Decidable P] (a : α) : ite P 1 0 * a = ite P a 0 := sorry

theorem ite_mul_zero_left {α : Type u_1} [mul_zero_class α] (P : Prop) [Decidable P] (a : α) (b : α) : ite P (a * b) 0 = ite P a 0 * b := sorry

theorem ite_mul_zero_right {α : Type u_1} [mul_zero_class α] (P : Prop) [Decidable P] (a : α) (b : α) : ite P (a * b) 0 = a * ite P b 0 := sorry

/-- An element `a` of a semiring is even if there exists `k` such `a = 2*k`. -/
def even {α : Type u} [semiring α] (a : α) :=
  ∃ (k : α), a = bit0 1 * k

theorem even_iff_two_dvd {α : Type u} [semiring α] {a : α} : even a ↔ bit0 1 ∣ a :=
  iff.rfl

/-- An element `a` of a semiring is odd if there exists `k` such `a = 2*k + 1`. -/
def odd {α : Type u} [semiring α] (a : α) :=
  ∃ (k : α), a = bit0 1 * k + 1

theorem dvd_add {α : Type u} [semiring α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := sorry

namespace add_monoid_hom

/-- Left multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_left {R : Type u_1} [semiring R] (r : R) : R →+ R :=
  mk (Mul.mul r) sorry sorry

@[simp] theorem coe_mul_left {R : Type u_1} [semiring R] (r : R) : ⇑(mul_left r) = Mul.mul r :=
  rfl

/-- Right multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_right {R : Type u_1} [semiring R] (r : R) : R →+ R :=
  mk (fun (a : R) => a * r) sorry sorry

@[simp] theorem coe_mul_right {R : Type u_1} [semiring R] (r : R) : ⇑(mul_right r) = fun (_x : R) => _x * r :=
  rfl

theorem mul_right_apply {R : Type u_1} [semiring R] (a : R) (r : R) : coe_fn (mul_right r) a = a * r :=
  rfl

end add_monoid_hom

/-- Bundled semiring homomorphisms; use this for bundled ring homomorphisms too.

This extends from both `monoid_hom` and `monoid_with_zero_hom` in order to put the fields in a
sensible order, even though `monoid_with_zero_hom` already extends `monoid_hom`. -/
structure ring_hom (α : Type u_1) (β : Type u_2) [semiring α] [semiring β]
extends monoid_with_zero_hom α β, α →* β, α →+ β
where

infixr:25 " →+* " => Mathlib.ring_hom

/-- Reinterpret a ring homomorphism `f : R →+* S` as a `monoid_with_zero_hom R S`.
The `simp`-normal form is `(f : monoid_with_zero_hom R S)`. -/
/-- Reinterpret a ring homomorphism `f : R →+* S` as a monoid homomorphism `R →* S`.
The `simp`-normal form is `(f : R →* S)`. -/
/-- Reinterpret a ring homomorphism `f : R →+* S` as an additive monoid homomorphism `R →+ S`.
The `simp`-normal form is `(f : R →+ S)`. -/
namespace ring_hom

/-!
Throughout this section, some `semiring` arguments are specified with `{}` instead of `[]`.
See note [implicit instance arguments].
-/

protected instance has_coe_to_fun {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} : has_coe_to_fun (α →+* β) :=
  has_coe_to_fun.mk (fun (x : α →+* β) => α → β) to_fun

@[simp] theorem to_fun_eq_coe {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : to_fun f = ⇑f :=
  rfl

@[simp] theorem coe_mk {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α → β) (h₁ : f 1 = 1) (h₂ : ∀ (x y : α), f (x * y) = f x * f y) (h₃ : f 0 = 0) (h₄ : ∀ (x y : α), f (x + y) = f x + f y) : ⇑(mk f h₁ h₂ h₃ h₄) = f :=
  rfl

protected instance has_coe_monoid_hom {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} : has_coe (α →+* β) (α →* β) :=
  has_coe.mk to_monoid_hom

@[simp] theorem coe_monoid_hom {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : ⇑↑f = ⇑f :=
  rfl

@[simp] theorem to_monoid_hom_eq_coe {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : to_monoid_hom f = ↑f :=
  rfl

@[simp] theorem coe_monoid_hom_mk {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α → β) (h₁ : f 1 = 1) (h₂ : ∀ (x y : α), f (x * y) = f x * f y) (h₃ : f 0 = 0) (h₄ : ∀ (x y : α), f (x + y) = f x + f y) : ↑(mk f h₁ h₂ h₃ h₄) = monoid_hom.mk f h₁ h₂ :=
  rfl

protected instance has_coe_add_monoid_hom {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} : has_coe (α →+* β) (α →+ β) :=
  has_coe.mk to_add_monoid_hom

@[simp] theorem coe_add_monoid_hom {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : ⇑↑f = ⇑f :=
  rfl

@[simp] theorem to_add_monoid_hom_eq_coe {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : to_add_monoid_hom f = ↑f :=
  rfl

@[simp] theorem coe_add_monoid_hom_mk {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α → β) (h₁ : f 1 = 1) (h₂ : ∀ (x y : α), f (x * y) = f x * f y) (h₃ : f 0 = 0) (h₄ : ∀ (x y : α), f (x + y) = f x + f y) : ↑(mk f h₁ h₂ h₃ h₄) = add_monoid_hom.mk f h₃ h₄ :=
  rfl

theorem congr_fun {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} {f : α →+* β} {g : α →+* β} (h : f = g) (x : α) : coe_fn f x = coe_fn g x :=
  congr_arg (fun (h : α →+* β) => coe_fn h x) h

theorem congr_arg {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) {x : α} {y : α} (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (fun (x : α) => coe_fn f x) h

theorem coe_inj {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} {f : α →+* β} {g : α →+* β} (h : ⇑f = ⇑g) : f = g := sorry

theorem ext {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} {f : α →+* β} {g : α →+* β} (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  coe_inj (funext h)

theorem ext_iff {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} {f : α →+* β} {g : α →+* β} : f = g ↔ ∀ (x : α), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : α) => h ▸ rfl, mpr := fun (h : ∀ (x : α), coe_fn f x = coe_fn g x) => ext h }

@[simp] theorem mk_coe {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) (h₁ : coe_fn f 1 = 1) (h₂ : ∀ (x y : α), coe_fn f (x * y) = coe_fn f x * coe_fn f y) (h₃ : coe_fn f 0 = 0) (h₄ : ∀ (x y : α), coe_fn f (x + y) = coe_fn f x + coe_fn f y) : mk (⇑f) h₁ h₂ h₃ h₄ = f :=
  ext fun (_x : α) => rfl

theorem coe_add_monoid_hom_injective {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} : function.injective coe :=
  fun (f g : α →+* β) (h : ↑f = ↑g) => ext fun (x : α) => add_monoid_hom.congr_fun h x

theorem coe_monoid_hom_injective {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} : function.injective coe :=
  fun (f g : α →+* β) (h : ↑f = ↑g) => ext fun (x : α) => monoid_hom.congr_fun h x

/-- Ring homomorphisms map zero to zero. -/
@[simp] theorem map_zero {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : coe_fn f 0 = 0 :=
  map_zero' f

/-- Ring homomorphisms map one to one. -/
@[simp] theorem map_one {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : coe_fn f 1 = 1 :=
  map_one' f

/-- Ring homomorphisms preserve addition. -/
@[simp] theorem map_add {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) (a : α) (b : α) : coe_fn f (a + b) = coe_fn f a + coe_fn f b :=
  map_add' f a b

/-- Ring homomorphisms preserve multiplication. -/
@[simp] theorem map_mul {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) (a : α) (b : α) : coe_fn f (a * b) = coe_fn f a * coe_fn f b :=
  map_mul' f a b

/-- Ring homomorphisms preserve `bit0`. -/
@[simp] theorem map_bit0 {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) (a : α) : coe_fn f (bit0 a) = bit0 (coe_fn f a) :=
  map_add f a a

/-- Ring homomorphisms preserve `bit1`. -/
@[simp] theorem map_bit1 {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) (a : α) : coe_fn f (bit1 a) = bit1 (coe_fn f a) := sorry

/-- `f : R →+* S` has a trivial codomain iff `f 1 = 0`. -/
theorem codomain_trivial_iff_map_one_eq_zero {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : 0 = 1 ↔ coe_fn f 1 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 = 1 ↔ coe_fn f 1 = 0)) (map_one f)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 = 1 ↔ 1 = 0)) (propext eq_comm))) (iff.refl (1 = 0)))

/-- `f : R →+* S` has a trivial codomain iff it has a trivial range. -/
theorem codomain_trivial_iff_range_trivial {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : 0 = 1 ↔ ∀ (x : α), coe_fn f x = 0 := sorry

/-- `f : R →+* S` has a trivial codomain iff its range is `{0}`. -/
theorem codomain_trivial_iff_range_eq_singleton_zero {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) : 0 = 1 ↔ set.range ⇑f = singleton 0 := sorry

/-- `f : R →+* S` doesn't map `1` to `0` if `S` is nontrivial -/
theorem map_one_ne_zero {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) [nontrivial β] : coe_fn f 1 ≠ 0 :=
  mt (iff.mpr (codomain_trivial_iff_map_one_eq_zero f)) zero_ne_one

/-- If there is a homomorphism `f : R →+* S` and `S` is nontrivial, then `R` is nontrivial. -/
theorem domain_nontrivial {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) [nontrivial β] : nontrivial α := sorry

theorem is_unit_map {α : Type u} {β : Type v} {rα : semiring α} {rβ : semiring β} (f : α →+* β) {a : α} (h : is_unit a) : is_unit (coe_fn f a) :=
  is_unit.map (to_monoid_hom f) h

/-- The identity ring homomorphism from a semiring to itself. -/
def id (α : Type u_1) [semiring α] : α →+* α :=
  mk id sorry sorry sorry sorry

protected instance inhabited {α : Type u} [rα : semiring α] : Inhabited (α →+* α) :=
  { default := id α }

@[simp] theorem id_apply {α : Type u} [rα : semiring α] (x : α) : coe_fn (id α) x = x :=
  rfl

/-- Composition of ring homomorphisms is a ring homomorphism. -/
def comp {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} (hnp : β →+* γ) (hmn : α →+* β) : α →+* γ :=
  mk (⇑hnp ∘ ⇑hmn) sorry sorry sorry sorry

/-- Composition of semiring homomorphisms is associative. -/
theorem comp_assoc {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} {δ : Type u_1} {rδ : semiring δ} (f : α →+* β) (g : β →+* γ) (h : γ →+* δ) : comp (comp h g) f = comp h (comp g f) :=
  rfl

@[simp] theorem coe_comp {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} (hnp : β →+* γ) (hmn : α →+* β) : ⇑(comp hnp hmn) = ⇑hnp ∘ ⇑hmn :=
  rfl

theorem comp_apply {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} (hnp : β →+* γ) (hmn : α →+* β) (x : α) : coe_fn (comp hnp hmn) x = coe_fn hnp (coe_fn hmn x) :=
  rfl

@[simp] theorem comp_id {α : Type u} {β : Type v} [rα : semiring α] [rβ : semiring β] (f : α →+* β) : comp f (id α) = f :=
  ext fun (x : α) => rfl

@[simp] theorem id_comp {α : Type u} {β : Type v} [rα : semiring α] [rβ : semiring β] (f : α →+* β) : comp (id β) f = f :=
  ext fun (x : α) => rfl

protected instance monoid {α : Type u} [rα : semiring α] : monoid (α →+* α) :=
  monoid.mk comp sorry (id α) id_comp comp_id

theorem one_def {α : Type u} [rα : semiring α] : 1 = id α :=
  rfl

@[simp] theorem coe_one {α : Type u} [rα : semiring α] : ⇑1 = id :=
  rfl

theorem mul_def {α : Type u} [rα : semiring α] (f : α →+* α) (g : α →+* α) : f * g = comp f g :=
  rfl

@[simp] theorem coe_mul {α : Type u} [rα : semiring α] (f : α →+* α) (g : α →+* α) : ⇑(f * g) = ⇑f ∘ ⇑g :=
  rfl

theorem cancel_right {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} {g₁ : β →+* γ} {g₂ : β →+* γ} {f : α →+* β} (hf : function.surjective ⇑f) : comp g₁ f = comp g₂ f ↔ g₁ = g₂ :=
  { mp := fun (h : comp g₁ f = comp g₂ f) => ext (iff.mp (forall_iff_forall_surj hf) (iff.mp ext_iff h)),
    mpr := fun (h : g₁ = g₂) => h ▸ rfl }

theorem cancel_left {α : Type u} {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β] {rγ : semiring γ} {g : β →+* γ} {f₁ : α →+* β} {f₂ : α →+* β} (hg : function.injective ⇑g) : comp g f₁ = comp g f₂ ↔ f₁ = f₂ := sorry

end ring_hom

/-- A commutative semiring is a `semiring` with commutative multiplication. In other words, it is a
type with the following structures: additive commutative monoid (`add_comm_monoid`), multiplicative
commutative monoid (`comm_monoid`), distributive laws (`distrib`), and multiplication by zero law
(`mul_zero_class`). -/
class comm_semiring (α : Type u)
extends semiring α, comm_monoid α
where

protected instance comm_semiring.to_comm_monoid_with_zero {α : Type u} [comm_semiring α] : comm_monoid_with_zero α :=
  comm_monoid_with_zero.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry semiring.zero sorry sorry

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.injective.comm_semiring {α : Type u} {γ : Type w} [comm_semiring α] [HasZero γ] [HasOne γ] [Add γ] [Mul γ] (f : γ → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : γ), f (x + y) = f x + f y) (mul : ∀ (x y : γ), f (x * y) = f x * f y) : comm_semiring γ :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.surjective.comm_semiring {α : Type u} {γ : Type w} [comm_semiring α] [HasZero γ] [HasOne γ] [Add γ] [Mul γ] (f : α → γ) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) : comm_semiring γ :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

theorem add_mul_self_eq {α : Type u} [comm_semiring α] (a : α) (b : α) : (a + b) * (a + b) = a * a + bit0 1 * a * b + b * b := sorry

@[simp] theorem two_dvd_bit0 {α : Type u} [comm_semiring α] {a : α} : bit0 1 ∣ bit0 a :=
  Exists.intro a (bit0_eq_two_mul a)

theorem ring_hom.map_dvd {α : Type u} {β : Type v} [comm_semiring α] [comm_semiring β] (f : α →+* β) {a : α} {b : α} : a ∣ b → coe_fn f a ∣ coe_fn f b := sorry

/-!
### Rings
-/

/-- A ring is a type with the following structures: additive commutative group (`add_comm_group`),
multiplicative monoid (`monoid`), and distributive laws (`distrib`).  Equivalently, a ring is a
`semiring` with a negation operation making it an additive group.  -/
class ring (α : Type u)
extends monoid α, distrib α, add_comm_group α
where

/- The instance from `ring` to `semiring` happens often in linear algebra, for which all the basic
definitions are given in terms of semirings, but many applications use rings or fields. We increase
a little bit its priority above 100 to try it quickly, but remaining below the default 1000 so that
more specific instances are tried first. -/

protected instance ring.to_semiring {α : Type u} [ring α] : semiring α :=
  semiring.mk ring.add ring.add_assoc ring.zero ring.zero_add ring.add_zero ring.add_comm ring.mul ring.mul_assoc ring.one
    ring.one_mul ring.mul_one sorry sorry ring.left_distrib ring.right_distrib

/-- Pullback a `ring` instance along an injective function. -/
protected def function.injective.ring {α : Type u} {β : Type v} [ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) : ring β :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    monoid.mul sorry monoid.one sorry sorry sorry sorry

/-- Pullback a `ring` instance along an injective function,
with a subtraction (`-`) that is not necessarily defeq to `a + -b`. -/
protected def function.injective.ring_sub {α : Type u} {β : Type v} [ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] [Sub β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) (sub : ∀ (x y : β), f (x - y) = f x - f y) : ring β :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    monoid.mul sorry monoid.one sorry sorry sorry sorry

/-- Pullback a `ring` instance along an injective function. -/
protected def function.surjective.ring {α : Type u} {β : Type v} [ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : α → β) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) (neg : ∀ (x : α), f (-x) = -f x) : ring β :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    monoid.mul sorry monoid.one sorry sorry sorry sorry

/-- Pullback a `ring` instance along an injective function,
with a subtraction (`-`) that is not necessarily defeq to `a + -b`. -/
protected def function.surjective.ring_sub {α : Type u} {β : Type v} [ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] [Sub β] (f : α → β) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) (neg : ∀ (x : α), f (-x) = -f x) (sub : ∀ (x y : α), f (x - y) = f x - f y) : ring β :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    monoid.mul sorry monoid.one sorry sorry sorry sorry

theorem neg_mul_eq_neg_mul {α : Type u} [ring α] (a : α) (b : α) : -(a * b) = -a * b := sorry

theorem neg_mul_eq_mul_neg {α : Type u} [ring α] (a : α) (b : α) : -(a * b) = a * -b := sorry

@[simp] theorem neg_mul_eq_neg_mul_symm {α : Type u} [ring α] (a : α) (b : α) : -a * b = -(a * b) :=
  Eq.symm (neg_mul_eq_neg_mul a b)

@[simp] theorem mul_neg_eq_neg_mul_symm {α : Type u} [ring α] (a : α) (b : α) : a * -b = -(a * b) :=
  Eq.symm (neg_mul_eq_mul_neg a b)

theorem neg_mul_neg {α : Type u} [ring α] (a : α) (b : α) : -a * -b = a * b := sorry

theorem neg_mul_comm {α : Type u} [ring α] (a : α) (b : α) : -a * b = a * -b := sorry

theorem neg_eq_neg_one_mul {α : Type u} [ring α] (a : α) : -a = -1 * a := sorry

theorem mul_sub_left_distrib {α : Type u} [ring α] (a : α) (b : α) (c : α) : a * (b - c) = a * b - a * c := sorry

theorem mul_sub {α : Type u} [ring α] (a : α) (b : α) (c : α) : a * (b - c) = a * b - a * c :=
  mul_sub_left_distrib

theorem mul_sub_right_distrib {α : Type u} [ring α] (a : α) (b : α) (c : α) : (a - b) * c = a * c - b * c := sorry

theorem sub_mul {α : Type u} [ring α] (a : α) (b : α) (c : α) : (a - b) * c = a * c - b * c :=
  mul_sub_right_distrib

/-- An element of a ring multiplied by the additive inverse of one is the element's additive
  inverse. -/
theorem mul_neg_one {α : Type u} [ring α] (a : α) : a * -1 = -a := sorry

/-- The additive inverse of one multiplied by an element of a ring is the element's additive
  inverse. -/
theorem neg_one_mul {α : Type u} [ring α] (a : α) : -1 * a = -a := sorry

/-- An iff statement following from right distributivity in rings and the definition
  of subtraction. -/
theorem mul_add_eq_mul_add_iff_sub_mul_add_eq {α : Type u} [ring α] {a : α} {b : α} {c : α} {d : α} {e : α} : a * e + c = b * e + d ↔ (a - b) * e + c = d := sorry

/-- A simplification of one side of an equation exploiting right distributivity in rings
  and the definition of subtraction. -/
theorem sub_mul_add_eq_of_mul_add_eq_mul_add {α : Type u} [ring α] {a : α} {b : α} {c : α} {d : α} {e : α} : a * e + c = b * e + d → (a - b) * e + c = d := sorry

namespace units

/-- Each element of the group of units of a ring has an additive inverse. -/
protected instance has_neg {α : Type u} [ring α] : Neg (units α) :=
  { neg := fun (u : units α) => mk (-↑u) (-↑(u⁻¹)) sorry sorry }

/-- Representing an element of a ring's unit group as an element of the ring commutes with
    mapping this element to its additive inverse. -/
@[simp] protected theorem coe_neg {α : Type u} [ring α] (u : units α) : ↑(-u) = -↑u :=
  rfl

@[simp] protected theorem coe_neg_one {α : Type u} [ring α] : ↑(-1) = -1 :=
  rfl

/-- Mapping an element of a ring's unit group to its inverse commutes with mapping this element
    to its additive inverse. -/
@[simp] protected theorem neg_inv {α : Type u} [ring α] (u : units α) : -u⁻¹ = -(u⁻¹) :=
  rfl

/-- An element of a ring's unit group equals the additive inverse of its additive inverse. -/
@[simp] protected theorem neg_neg {α : Type u} [ring α] (u : units α) : --u = u :=
  ext (neg_neg ↑u)

/-- Multiplication of elements of a ring's unit group commutes with mapping the first
    argument to its additive inverse. -/
@[simp] protected theorem neg_mul {α : Type u} [ring α] (u₁ : units α) (u₂ : units α) : -u₁ * u₂ = -(u₁ * u₂) :=
  ext (neg_mul_eq_neg_mul_symm (↑u₁) (val u₂))

/-- Multiplication of elements of a ring's unit group commutes with mapping the second argument
    to its additive inverse. -/
@[simp] protected theorem mul_neg {α : Type u} [ring α] (u₁ : units α) (u₂ : units α) : u₁ * -u₂ = -(u₁ * u₂) :=
  ext (Eq.symm (neg_mul_eq_mul_neg (val u₁) ↑u₂))

/-- Multiplication of the additive inverses of two elements of a ring's unit group equals
    multiplication of the two original elements. -/
@[simp] protected theorem neg_mul_neg {α : Type u} [ring α] (u₁ : units α) (u₂ : units α) : -u₁ * -u₂ = u₁ * u₂ := sorry

/-- The additive inverse of an element of a ring's unit group equals the additive inverse of
    one times the original element. -/
protected theorem neg_eq_neg_one_mul {α : Type u} [ring α] (u : units α) : -u = -1 * u := sorry

end units

namespace ring_hom

/-- Ring homomorphisms preserve additive inverse. -/
@[simp] theorem map_neg {α : Type u_1} {β : Type u_2} [ring α] [ring β] (f : α →+* β) (x : α) : coe_fn f (-x) = -coe_fn f x :=
  add_monoid_hom.map_neg (↑f) x

/-- Ring homomorphisms preserve subtraction. -/
@[simp] theorem map_sub {α : Type u_1} {β : Type u_2} [ring α] [ring β] (f : α →+* β) (x : α) (y : α) : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  add_monoid_hom.map_sub (↑f) x y

/-- A ring homomorphism is injective iff its kernel is trivial. -/
theorem injective_iff {α : Type u_1} {β : Type u_2} [ring α] [semiring β] (f : α →+* β) : function.injective ⇑f ↔ ∀ (a : α), coe_fn f a = 0 → a = 0 :=
  add_monoid_hom.injective_iff ↑f

/-- Makes a ring homomorphism from a monoid homomorphism of rings which preserves addition. -/
def mk' {α : Type u} {γ : Type u_1} [semiring α] [ring γ] (f : α →* γ) (map_add : ∀ (a b : α), coe_fn f (a + b) = coe_fn f a + coe_fn f b) : α →+* γ :=
  mk ⇑f sorry sorry sorry sorry

end ring_hom

/-- A commutative ring is a `ring` with commutative multiplication. -/
class comm_ring (α : Type u)
extends ring α, comm_semigroup α
where

protected instance comm_ring.to_comm_semiring {α : Type u} [s : comm_ring α] : comm_semiring α :=
  comm_semiring.mk comm_ring.add comm_ring.add_assoc comm_ring.zero comm_ring.zero_add comm_ring.add_zero
    comm_ring.add_comm comm_ring.mul comm_ring.mul_assoc comm_ring.one comm_ring.one_mul comm_ring.mul_one sorry sorry
    comm_ring.left_distrib comm_ring.right_distrib comm_ring.mul_comm

/-- Pullback a `comm_ring` instance along an injective function. -/
protected def function.injective.comm_ring {α : Type u} {β : Type v} [comm_ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) : comm_ring β :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

/-- Pullback a `comm_ring` instance along an injective function,
with a subtraction (`-`) that is not necessarily defeq to `a + -b`. -/
protected def function.injective.comm_ring_sub {α : Type u} {β : Type v} [comm_ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] [Sub β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) (sub : ∀ (x y : β), f (x - y) = f x - f y) : comm_ring β :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

/-- Pullback a `comm_ring` instance along an injective function. -/
protected def function.surjective.comm_ring {α : Type u} {β : Type v} [comm_ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : α → β) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) (neg : ∀ (x : α), f (-x) = -f x) : comm_ring β :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

/-- Pullback a `comm_ring` instance along an injective function,
with a subtraction (`-`) that is not necessarily defeq to `a + -b`. -/
protected def function.surjective.comm_ring_sub {α : Type u} {β : Type v} [comm_ring α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] [Sub β] (f : α → β) (hf : function.surjective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : α), f (x + y) = f x + f y) (mul : ∀ (x y : α), f (x * y) = f x * f y) (neg : ∀ (x : α), f (-x) = -f x) (sub : ∀ (x y : α), f (x - y) = f x - f y) : comm_ring β :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

theorem dvd_neg_of_dvd {α : Type u} [comm_ring α] {a : α} {b : α} (h : a ∣ b) : a ∣ -b := sorry

theorem dvd_of_dvd_neg {α : Type u} [comm_ring α] {a : α} {b : α} (h : a ∣ -b) : a ∣ b :=
  let t : a ∣ --b := dvd_neg_of_dvd h;
  eq.mp (Eq._oldrec (Eq.refl (a ∣ --b)) (neg_neg b)) t

theorem dvd_neg_iff_dvd {α : Type u} [comm_ring α] (a : α) (b : α) : a ∣ -b ↔ a ∣ b :=
  { mp := dvd_of_dvd_neg, mpr := dvd_neg_of_dvd }

theorem neg_dvd_of_dvd {α : Type u} [comm_ring α] {a : α} {b : α} (h : a ∣ b) : -a ∣ b := sorry

theorem dvd_of_neg_dvd {α : Type u} [comm_ring α] {a : α} {b : α} (h : -a ∣ b) : a ∣ b :=
  let t : --a ∣ b := neg_dvd_of_dvd h;
  eq.mp (Eq._oldrec (Eq.refl ( --a ∣ b)) (neg_neg a)) t

theorem neg_dvd_iff_dvd {α : Type u} [comm_ring α] (a : α) (b : α) : -a ∣ b ↔ a ∣ b :=
  { mp := dvd_of_neg_dvd, mpr := neg_dvd_of_dvd }

theorem dvd_sub {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ b - c)) (sub_eq_add_neg b c))) (dvd_add h₁ (dvd_neg_of_dvd h₂))

theorem dvd_add_iff_left {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h : a ∣ c) : a ∣ b ↔ a ∣ b + c :=
  { mp := fun (h₂ : a ∣ b) => dvd_add h₂ h,
    mpr := fun (H : a ∣ b + c) => eq.mp (Eq._oldrec (Eq.refl (a ∣ b + c - c)) (add_sub_cancel b c)) (dvd_sub H h) }

theorem dvd_add_iff_right {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h : a ∣ b) : a ∣ c ↔ a ∣ b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ∣ c ↔ a ∣ b + c)) (add_comm b c))) (dvd_add_iff_left h)

theorem two_dvd_bit1 {α : Type u} [comm_ring α] {a : α} : bit0 1 ∣ bit1 a ↔ bit0 1 ∣ 1 :=
  iff.symm (dvd_add_iff_right two_dvd_bit0)

/-- Representation of a difference of two squares in a commutative ring as a product. -/
theorem mul_self_sub_mul_self {α : Type u} [comm_ring α] (a : α) (b : α) : a * a - b * b = (a + b) * (a - b) := sorry

theorem mul_self_sub_one {α : Type u} [comm_ring α] (a : α) : a * a - 1 = (a + 1) * (a - 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * a - 1 = (a + 1) * (a - 1))) (Eq.symm (mul_self_sub_mul_self a 1))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * a - 1 = a * a - 1 * 1)) (mul_one 1))) (Eq.refl (a * a - 1)))

/-- An element a of a commutative ring divides the additive inverse of an element b iff a
  divides b. -/
@[simp] theorem dvd_neg {α : Type u} [comm_ring α] (a : α) (b : α) : a ∣ -b ↔ a ∣ b :=
  { mp := dvd_of_dvd_neg, mpr := dvd_neg_of_dvd }

/-- The additive inverse of an element a of a commutative ring divides another element b iff a
  divides b. -/
@[simp] theorem neg_dvd {α : Type u} [comm_ring α] (a : α) (b : α) : -a ∣ b ↔ a ∣ b :=
  { mp := dvd_of_neg_dvd, mpr := neg_dvd_of_dvd }

/-- If an element a divides another element c in a commutative ring, a divides the sum of another
  element b with c iff a divides b. -/
theorem dvd_add_left {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h : a ∣ c) : a ∣ b + c ↔ a ∣ b :=
  iff.symm (dvd_add_iff_left h)

/-- If an element a divides another element b in a commutative ring, a divides the sum of b and
  another element c iff a divides c. -/
theorem dvd_add_right {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h : a ∣ b) : a ∣ b + c ↔ a ∣ c :=
  iff.symm (dvd_add_iff_right h)

/-- An element a divides the sum a + b if and only if a divides b.-/
@[simp] theorem dvd_add_self_left {α : Type u} [comm_ring α] {a : α} {b : α} : a ∣ a + b ↔ a ∣ b :=
  dvd_add_right (dvd_refl a)

/-- An element a divides the sum b + a if and only if a divides b.-/
@[simp] theorem dvd_add_self_right {α : Type u} [comm_ring α] {a : α} {b : α} : a ∣ b + a ↔ a ∣ b :=
  dvd_add_left (dvd_refl a)

/-- Vieta's formula for a quadratic equation, relating the coefficients of the polynomial with
  its roots. This particular version states that if we have a root `x` of a monic quadratic
  polynomial, then there is another root `y` such that `x + y` is negative the `a_1` coefficient
  and `x * y` is the `a_0` coefficient. -/
theorem Vieta_formula_quadratic {α : Type u} [comm_ring α] {b : α} {c : α} {x : α} (h : x * x - b * x + c = 0) : ∃ (y : α), y * y - b * y + c = 0 ∧ x + y = b ∧ x * y = c := sorry

theorem dvd_mul_sub_mul {α : Type u} [comm_ring α] {k : α} {a : α} {b : α} {x : α} {y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) : k ∣ a * x - b * y := sorry

theorem dvd_iff_dvd_of_dvd_sub {α : Type u} [comm_ring α] {a : α} {b : α} {c : α} (h : a ∣ b - c) : a ∣ b ↔ a ∣ c := sorry

theorem succ_ne_self {α : Type u} [ring α] [nontrivial α] (a : α) : a + 1 ≠ a := sorry

theorem pred_ne_self {α : Type u} [ring α] [nontrivial α] (a : α) : a - 1 ≠ a := sorry

/-- A domain is a ring with no zero divisors, i.e. satisfying
  the condition `a * b = 0 ↔ a = 0 ∨ b = 0`. Alternatively, a domain
  is an integral domain without assuming commutativity of multiplication. -/
class domain (α : Type u)
extends ring α, nontrivial α
where
  eq_zero_or_eq_zero_of_mul_eq_zero : ∀ (a b : α), a * b = 0 → a = 0 ∨ b = 0

protected instance domain.to_no_zero_divisors {α : Type u} [domain α] : no_zero_divisors α :=
  no_zero_divisors.mk domain.eq_zero_or_eq_zero_of_mul_eq_zero

protected instance domain.to_cancel_monoid_with_zero {α : Type u} [domain α] : cancel_monoid_with_zero α :=
  cancel_monoid_with_zero.mk semiring.mul sorry semiring.one sorry sorry semiring.zero sorry sorry sorry sorry

/-- Pullback a `domain` instance along an injective function. -/
protected def function.injective.domain {α : Type u} {β : Type v} [domain α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) : domain β :=
  domain.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry sorry
    sorry sorry sorry

/-!
### Integral domains
-/

/-- An integral domain is a commutative ring with no zero divisors, i.e. satisfying the condition
`a * b = 0 ↔ a = 0 ∨ b = 0`. Alternatively, an integral domain is a domain with commutative
multiplication. -/
class integral_domain (α : Type u)
extends comm_ring α, domain α
where

protected instance integral_domain.to_comm_cancel_monoid_with_zero {α : Type u} [integral_domain α] : comm_cancel_monoid_with_zero α :=
  comm_cancel_monoid_with_zero.mk comm_monoid_with_zero.mul sorry comm_monoid_with_zero.one sorry sorry sorry
    comm_monoid_with_zero.zero sorry sorry sorry sorry

/-- Pullback an `integral_domain` instance along an injective function. -/
protected def function.injective.integral_domain {α : Type u} {β : Type v} [integral_domain α] [HasZero β] [HasOne β] [Add β] [Mul β] [Neg β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ (x y : β), f (x + y) = f x + f y) (mul : ∀ (x y : β), f (x * y) = f x * f y) (neg : ∀ (x : β), f (-x) = -f x) : integral_domain β :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry sorry

theorem mul_self_eq_mul_self_iff {α : Type u} [integral_domain α] {a : α} {b : α} : a * a = b * b ↔ a = b ∨ a = -b := sorry

theorem mul_self_eq_one_iff {α : Type u} [integral_domain α] {a : α} : a * a = 1 ↔ a = 1 ∨ a = -1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * a = 1 ↔ a = 1 ∨ a = -1)) (Eq.symm (propext mul_self_eq_mul_self_iff))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * a = 1 ↔ a * a = 1 * 1)) (one_mul 1))) (iff.refl (a * a = 1)))

/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or
  one's additive inverse. -/
theorem units.inv_eq_self_iff {α : Type u} [integral_domain α] (u : units α) : u⁻¹ = u ↔ u = 1 ∨ u = -1 := sorry

namespace ring

/-- Introduce a function `inverse` on a ring `R`, which sends `x` to `x⁻¹` if `x` is invertible and
to `0` otherwise.  This definition is somewhat ad hoc, but one needs a fully (rather than partially)
defined inverse function for some purposes, including for calculus. -/
def inverse {R : Type x} [ring R] : R → R :=
  fun (x : R) => dite (is_unit x) (fun (h : is_unit x) => ↑(classical.some h⁻¹)) fun (h : ¬is_unit x) => 0

/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/
@[simp] theorem inverse_unit {R : Type x} [ring R] (a : units R) : inverse ↑a = ↑(a⁻¹) := sorry

/-- By definition, if `x` is not invertible then `inverse x = 0`. -/
@[simp] theorem inverse_non_unit {R : Type x} [ring R] (x : R) (h : ¬is_unit x) : inverse x = 0 :=
  dif_neg h

end ring

/-- A predicate to express that a ring is an integral domain.

This is mainly useful because such a predicate does not contain data,
and can therefore be easily transported along ring isomorphisms. -/
structure is_integral_domain (R : Type u) [ring R]
extends nontrivial R
where
  mul_comm : ∀ (x y : R), x * y = y * x
  eq_zero_or_eq_zero_of_mul_eq_zero : ∀ (x y : R), x * y = 0 → x = 0 ∨ y = 0

-- The linter does not recognize that is_integral_domain.to_nontrivial is a structure

-- projection, disable it

/-- Every integral domain satisfies the predicate for integral domains. -/
theorem integral_domain.to_is_integral_domain (R : Type u) [integral_domain R] : is_integral_domain R :=
  is_integral_domain.mk integral_domain.exists_pair_ne integral_domain.mul_comm
    integral_domain.eq_zero_or_eq_zero_of_mul_eq_zero

/-- If a ring satisfies the predicate for integral domains,
then it can be endowed with an `integral_domain` instance
whose data is definitionally equal to the existing data. -/
def is_integral_domain.to_integral_domain (R : Type u) [ring R] (h : is_integral_domain R) : integral_domain R :=
  integral_domain.mk ring.add ring.add_assoc ring.zero ring.zero_add ring.add_zero ring.neg ring.sub ring.add_left_neg
    ring.add_comm ring.mul ring.mul_assoc ring.one ring.one_mul ring.mul_one ring.left_distrib ring.right_distrib
    (is_integral_domain.mul_comm h) (is_integral_domain.exists_pair_ne h)
    (is_integral_domain.eq_zero_or_eq_zero_of_mul_eq_zero h)

namespace semiconj_by

@[simp] theorem add_right {R : Type x} [distrib R] {a : R} {x : R} {y : R} {x' : R} {y' : R} (h : semiconj_by a x y) (h' : semiconj_by a x' y') : semiconj_by a (x + x') (y + y') := sorry

@[simp] theorem add_left {R : Type x} [distrib R] {a : R} {b : R} {x : R} {y : R} (ha : semiconj_by a x y) (hb : semiconj_by b x y) : semiconj_by (a + b) x y := sorry

theorem neg_right {R : Type x} [ring R] {a : R} {x : R} {y : R} (h : semiconj_by a x y) : semiconj_by a (-x) (-y) := sorry

@[simp] theorem neg_right_iff {R : Type x} [ring R] {a : R} {x : R} {y : R} : semiconj_by a (-x) (-y) ↔ semiconj_by a x y :=
  { mp := fun (h : semiconj_by a (-x) (-y)) => neg_neg x ▸ neg_neg y ▸ neg_right h, mpr := neg_right }

theorem neg_left {R : Type x} [ring R] {a : R} {x : R} {y : R} (h : semiconj_by a x y) : semiconj_by (-a) x y := sorry

@[simp] theorem neg_left_iff {R : Type x} [ring R] {a : R} {x : R} {y : R} : semiconj_by (-a) x y ↔ semiconj_by a x y :=
  { mp := fun (h : semiconj_by (-a) x y) => neg_neg a ▸ neg_left h, mpr := neg_left }

@[simp] theorem neg_one_right {R : Type x} [ring R] (a : R) : semiconj_by a (-1) (-1) :=
  neg_right (one_right a)

@[simp] theorem neg_one_left {R : Type x} [ring R] (x : R) : semiconj_by (-1) x x :=
  neg_left (one_left x)

@[simp] theorem sub_right {R : Type x} [ring R] {a : R} {x : R} {y : R} {x' : R} {y' : R} (h : semiconj_by a x y) (h' : semiconj_by a x' y') : semiconj_by a (x - x') (y - y') := sorry

@[simp] theorem sub_left {R : Type x} [ring R] {a : R} {b : R} {x : R} {y : R} (ha : semiconj_by a x y) (hb : semiconj_by b x y) : semiconj_by (a - b) x y := sorry

end semiconj_by

namespace commute

@[simp] theorem add_right {R : Type x} [distrib R] {a : R} {b : R} {c : R} : commute a b → commute a c → commute a (b + c) :=
  semiconj_by.add_right

@[simp] theorem add_left {R : Type x} [distrib R] {a : R} {b : R} {c : R} : commute a c → commute b c → commute (a + b) c :=
  semiconj_by.add_left

theorem neg_right {R : Type x} [ring R] {a : R} {b : R} : commute a b → commute a (-b) :=
  semiconj_by.neg_right

@[simp] theorem neg_right_iff {R : Type x} [ring R] {a : R} {b : R} : commute a (-b) ↔ commute a b :=
  semiconj_by.neg_right_iff

theorem neg_left {R : Type x} [ring R] {a : R} {b : R} : commute a b → commute (-a) b :=
  semiconj_by.neg_left

@[simp] theorem neg_left_iff {R : Type x} [ring R] {a : R} {b : R} : commute (-a) b ↔ commute a b :=
  semiconj_by.neg_left_iff

@[simp] theorem neg_one_right {R : Type x} [ring R] (a : R) : commute a (-1) :=
  semiconj_by.neg_one_right a

@[simp] theorem neg_one_left {R : Type x} [ring R] (a : R) : commute (-1) a :=
  semiconj_by.neg_one_left a

@[simp] theorem sub_right {R : Type x} [ring R] {a : R} {b : R} {c : R} : commute a b → commute a c → commute a (b - c) :=
  semiconj_by.sub_right

@[simp] theorem sub_left {R : Type x} [ring R] {a : R} {b : R} {c : R} : commute a c → commute b c → commute (a - b) c :=
  semiconj_by.sub_left


import order_mv_polynomial

open mv_polynomial finsupp

namespace mv_polynomial
variables {σ : Type*} {α : Type*} [decidable_eq σ] [decidable_eq α] [fintype σ] [decidable_linear_order (σ →₀ ℕ)]
[is_well_founded (σ →₀ ℕ) (<)] [is_monomial_order (σ →₀ ℕ) (≤)]
section lt
variables [comm_ring α]

inductive lt : (mv_polynomial σ α) → (mv_polynomial σ α) → Prop
| zero : ∀ {p : mv_polynomial σ α}, p ≠ 0 → lt 0 p
| LM_eq : ∀ {p q : mv_polynomial σ α}, q ≠ 0 → p.LT = q.LT → lt p.TL q.TL → lt p q
| LM_lt : ∀ {p q : mv_polynomial σ α}, p.LM < q.LM → lt p q

instance : has_lt (mv_polynomial σ α) := ⟨lt⟩

lemma LM_le_of_lt {x y : mv_polynomial σ α} (h : x < y) : x.LM ≤ y.LM :=
begin
    cases h,
    simp [finsupp.zero_le],
    apply le_of_eq (LM_eq_of_LT_eq _), assumption,
    apply le_of_lt, assumption,
end

lemma not_lt_zero {x : mv_polynomial σ α} : ¬ x < 0 :=
λ h, begin
    cases h,
    {finish},
    {finish},
    {apply (not_lt_zero _) (by simpa using h_a)},
end

lemma acc_zero : acc ((<) : mv_polynomial σ α → mv_polynomial σ α → Prop) 0 :=
begin
    apply acc.intro,
    intros y hy,
    apply absurd hy not_lt_zero,
end

lemma acc_C : ∀ a, acc ((<) : mv_polynomial σ α → mv_polynomial σ α → Prop) (C a) :=
λ a, begin
    apply acc.intro,
    intros y hy,
    cases hy with _ _ _ _ hy₁ hy₂ hy₃ _ _ hy,
    {simp [acc_zero]},
    {
        conv at hy₂ {change y.LT = (monomial 0 a).LT, rw LT_eq_iff_LM_LC_eq, simp},
        conv at hy₃ {
            change lt y.TL (monomial 0 a).TL,
            simp [TL_eqz_of_LM_eqz hy₂.left, TL_eqz_of_LM_eqz (@LM_of_monomial' σ _ _ _ _ _ a)],
        },
        apply absurd hy₃ not_lt_zero,
    },
    {
        conv at hy {change y.LM < (monomial 0 a).LM, simp},
        apply absurd hy (finsupp.not_lt_zero _),
    }
end

lemma acc_monomial_add {a b} (h : acc (<) (monomial a b))
: ∀ p : mv_polynomial σ α, a > p.LM → b ≠ 0 → acc (<) (monomial a b + p) :=
λ p ha hb, begin
    have : acc (<) p := acc.inv h (lt.LM_lt (by simpa [hb] using ha)),
    induction this with x ih₁ ih₂,
    by_cases hx : x = 0,
    {simpa [hx] using h},
    {
        apply acc.intro,
        intros y hy,
        cases hy with _ _ _ _ hy₁ hy₂ hy₃ _ _ hy,
        {simp [acc_zero]},
        {
            conv at hy₁ {change monomial a b + x ≠ 0},
            conv at hy₂ {change y.LT = (monomial a b + x).LT},
            conv at hy₃ {change lt y.TL (monomial a b + x).TL, rw TL_of_add_gt_LM ha hb},
            rw [←LM_TL_eq y, hy₂],
            simp [LT_of_add_gt_LM ha hb, -add_comm],
            apply ih₂ _ hy₃ (lt_of_le_of_lt (LM_le_of_lt hy₃) ha),
        },
        {
            conv at hy {
                change y.LM < (monomial a b + x).LM,
                rw [LM_of_add_gt_LM ha hb, eq_LM_of_monomial a hb]
            },
            apply acc.inv h (lt.LM_lt hy),
        }
    }
end

lemma acc_monomial : ∀ a b, acc ((<) : mv_polynomial σ α → mv_polynomial σ α → Prop) (monomial a b) :=
λ a,  well_founded.recursion _inst_5.wf a (begin
    intros x ih b,
    by_cases hb : b = 0,
    {simp [hb, acc_zero]},
    {
        apply acc.intro,
        intros y hy,
        cases hy with _ _ _ _ hy₁ hy₂ hy₃ _ _ hy,
        {simp [acc_zero]},
        {
            conv at hy₃ {change lt y.TL (monomial x b).TL, simp},
            apply absurd hy₃ not_lt_zero,
        },
        {
            by_cases hy' : y.LM = 0,
            {rw [eqC_of_LM_eqz.1 hy'], apply acc_C},
            {
                conv at hy {change y.LM < (monomial x b).LM, simp [hb]},
                rw ←LM_TL_eq y,
                apply acc_monomial_add (ih y.LM hy y.LC) _ (gt_TL_LM_of_LM_nez hy') (LC_nez_of_LM_nez hy'),
            }
        }
    }
end)

theorem lt_wf : well_founded ((<) : mv_polynomial σ α → mv_polynomial σ α → Prop) :=
well_founded.intro (λ p, begin
    by_cases hp : p.LM = 0,
    {rw eqC_of_LM_eqz.1 hp, apply acc_C},
    {
        rw ←LM_TL_eq p,
        apply acc_monomial_add (acc_monomial p.LM p.LC) _ (gt_TL_LM_of_LM_nez hp) (LC_nez_of_LM_nez hp),
    }
end)

instance : has_well_founded (mv_polynomial σ α) := {r := (<), wf := lt_wf}

lemma TL_lt {p : mv_polynomial σ α} (h : p ≠ 0) : p.TL < p :=
begin
    by_cases hp : p.LM = 0,
    {simp [TL_eqz_of_LM_eqz hp], exact lt.zero h},
    {
        apply lt.LM_lt,
        apply gt_TL_LM_of_LM_nez hp,
    }
end

lemma nez_of_gt {p q : mv_polynomial σ α} (h : p < q) : q ≠ 0 :=
λ h', begin
    rw h' at h,
    exact not_lt_zero h,
end

lemma gt_zero_of_gt {p q : mv_polynomial σ α} (h : p < q) : 0 < q := lt.zero (nez_of_gt h)

instance : is_trans (mv_polynomial σ α) (<) :=
⟨λ p q r hpq, begin
    revert r,
    induction hpq with _ _ p q hq hpq₁ hpq₂ ih p q hpq;
    intros r hqr,
    {exact gt_zero_of_gt hqr},
    {
        cases hqr with _ _ _ _ hr hqr₁ hqr₂ _ _ hqr,
        {finish},
        {exact lt.LM_eq hr (by rwa hpq₁) (ih _ hqr₂)},
        {exact lt.LM_lt (lt_of_le_of_lt (le_of_eq (LM_eq_of_LT_eq hpq₁)) hqr)}
    },
    {
        cases hqr with _ _ _ _ hr hqr₁ hqr₂ _ _ hqr,
        {exact absurd hpq (finsupp.not_lt_zero _)},
        {exact lt.LM_lt (lt_of_lt_of_le hpq (le_of_eq (LM_eq_of_LT_eq hqr₁)))},
        {exact lt.LM_lt (lt_trans hpq hqr)}
    }
end⟩

instance : is_irrefl (mv_polynomial σ α) (<) :=
⟨λ p, begin
    apply induction p,
    {exact not_lt_zero},
    {
        intros p ih hp,
        cases hp with _ _ _ _ hp h₁ h₂ _ _ h,
        {finish},
        {exact ih h₂},
        {exact (lt_irrefl _) h}
    }
end⟩

end lt
end mv_polynomial


-- Chapter 9.4 From "Articol rules"

import ProofMining.Proof
import ProofMining.Formula

open Formula (falsum WellFormed)
namespace Proof

variable {A B C : Formula} {e : Environment} {Γ : List Formula}

theorem r44
  (hyp : (e ;; Γ ⊢ A))
  (wfA : WellFormed e A := by autowf) (wfB : WellFormed e B := by autowf)
  : e ;; Γ ⊢ B ⟹ A :=
  let p₁ : e ;; Γ ⊢ A ⋀ B ⟹ A := weakConj (by assumption) (by assumption)
  let p₂ : e ;; Γ ⊢ A ⟹ (B ⟹ A) := exportation p₁ (by assumption) (by assumption) (by assumption)
  mpon hyp p₂ (by assumption) (by constructor <;> assumption)

set_option maxHeartbeats 1000000

theorem r45 (h₁ : e ;; Γ ⊢ A ⟹ B) (h₂ : e ;; Γ ⊢ A ⟹ C)
  (wfA : WellFormed e A := by autowf) (wfB : WellFormed e B := by autowf) (wfC : WellFormed e C := by autowf)
  : e ;; Γ ⊢ A ⟹ B ⋀ C :=
  let p₁ : e ;; Γ ⊢ B ⋀ C ⟹ B ⋀ C := syllogism permConj permConj
  let p₂ : e ;; Γ ⊢ B ⟹ (C ⟹ B ⋀ C) := exportation p₁
  let p₃ : e ;; Γ ⊢ A ⟹ (C ⟹ B ⋀ C) := syllogism h₁ p₂
  let p₄ : e ;; Γ ⊢ A ⋀ C ⟹ B ⋀ C := importation p₃
  let p₅ : e ;; Γ ⊢ C ⋀ A ⟹ B ⋀ C := syllogism (permConj) p₄
  let p₆ : e ;; Γ ⊢ C ⟹ (A ⟹ B ⋀ C) := exportation p₅
  let p₇ : e ;; Γ ⊢ A ⋀ A ⟹ B ⋀ C := importation (syllogism h₂ p₆)
  syllogism (contrConj) p₇
#check @r44

theorem r46 {A B C : Formula} (h : e ;; Γ ⊢ A ⟹ B)
  (wfA : WellFormed e A := by autowf) (wfB : WellFormed e B := by autowf) (wfC : WellFormed e C := by autowf)
  : e ;; Γ ⊢ A ⋀ C ⟹ B ⋀ C :=
  let p₁ : e ;; Γ ⊢ C ⋀ A ⟹ B := importation (r44 (h))
  let p₂ : e ;; Γ ⊢ A ⋀ C ⟹ B := syllogism (permConj) p₁
  let p₃ : e ;; Γ ⊢ A ⋀ C ⟹ C := syllogism (permConj) (weakConj)
  r45 p₂ p₃

theorem r49 {A B C : Formula} (h₁ : e ;; Γ ⊢ A ⟹ C) (h₂ : e ;; Γ ⊢ B ⟹ C)
  (wfA : WellFormed e A := by autowf) (wfB : WellFormed e B := by autowf) (wfC : WellFormed e C := by autowf)
  : e ;; Γ ⊢ A ⋁ B ⟹ C :=
  let p₁ : e ;; Γ ⊢ A ⋁ B ⟹ A ⋁ C := expansion A h₂
  let p₂ : e ;; Γ ⊢ C ⋁ A ⟹ C ⋁ C := expansion C h₁
  let p₃ : e ;; Γ ⊢ A ⋁ C ⟹ C ⋁ C := syllogism (permDisj) p₂
  let p₄ : e ;; Γ ⊢ A ⋁ C ⟹ C := syllogism p₃ (contrDisj)
  syllogism p₁ p₄

theorem r50 {A B : Formula} (h₁ : e ;; Γ ⊢ A) (h₂ : e ;; Γ ⊢ B)
  (wfA : WellFormed e A := by autowf)
  (wfB : WellFormed e B := by autowf)
  : e ;; Γ ⊢ A ⋀ B :=
  let p₁ : e ;; Γ ⊢ A ⟹ (B ⟹ A ⋀ B) := exportation (syllogism (permConj) (permConj))
  let p₂ : e ;; Γ ⊢ B ⟹ A ⋀ B  := mpon h₁ p₁
  mpon h₂ p₂

theorem r42 {A : Formula} {ρ : FiniteType} (h₁ : (ρ :: e) ;; Γ ⊢ A)
  (wfA : WellFormed (ρ :: e) A)
  : e ;; Γ ⊢ ∀∀ ρ A :=
  let p₁ : (ρ :: e) ;; Γ ⊢ A ⟹ A := syllogism (contrConj _) (weakConj _ _) _ _ _
  let p₂ : (ρ :: e) ;; Γ ⊢ A ⟹ ∀∀ ρ A := universalRule p₁
  mpon h₁ p₂

theorem r47 {A : Formula} {ρ : FiniteType} {t : Term} (h₁ : Γ ⊢ ∀∀ ρ A) : Γ ⊢ Formula.subst A 0 t :=
  mpon h₁ (universalAxiom ρ A t)


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.homology.single
import tactic.linarith

/-!
# Augmentation and truncation of `ℕ`-indexed (co)chain complexes.
-/

open category_theory
open category_theory.limits
open homological_complex

universes v u

variables {V : Type u} [category.{v} V]

namespace chain_complex

/--
The truncation of a `ℕ`-indexed chain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [has_zero_morphisms V] : chain_complex V ℕ ⥤ chain_complex V ℕ :=
{ obj := λ C,
  { X := λ i, C.X (i+1),
    d := λ i j, C.d (i+1) (j+1),
    shape' := λ i j w, by { apply C.shape, simpa }, },
  map := λ C D f,
  { f := λ i, f.f (i+1), }, }

/--
There is a canonical chain map from the truncation of a chain map `C` to
the "single object" chain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 1 0` in degree 0, and zero otherwise.
-/
def truncate_to [has_zero_object V] [has_zero_morphisms V] (C : chain_complex V ℕ) :
  truncate.obj C ⟶ (single₀ V).obj (C.X 0) :=
(to_single₀_equiv (truncate.obj C) (C.X 0)).symm ⟨C.d 1 0, by tidy⟩

-- PROJECT when `V` is abelian (but not generally?)
-- `[∀ n, exact (C.d (n+2) (n+1)) (C.d (n+1) n)] [epi (C.d 1 0)]` iff `quasi_iso (C.truncate_to)`

variables [has_zero_morphisms V]

/--
We can "augment" a chain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  chain_complex V ℕ :=
{ X := λ i, match i with
  | 0 := X
  | (i+1) := C.X i
  end,
  d := λ i j, match i, j with
  | 1, 0 := f
  | (i+1), (j+1) := C.d i j
  | _, _ := 0
  end,
  shape' := λ i j s, begin
    simp at s,
    rcases i with _|_|i; cases j; unfold_aux; try { simp },
    { simpa using s, },
    { rw [C.shape], simpa [← ne.def, nat.succ_ne_succ] using s },
  end,
  d_comp_d' := λ i j k hij hjk, begin
    rcases i with _|_|i; rcases j with _|_|j; cases k; unfold_aux; try { simp },
    cases i,
    { exact w, },
    { rw [C.shape, zero_comp],
      simpa using i.succ_succ_ne_one.symm },
  end, }

@[simp] lemma augment_X_zero (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  (augment C f w).X 0 = X := rfl

@[simp]

@[simp] lemma augment_d_one_zero
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  (augment C f w).d 1 0 = f := rfl

@[simp] lemma augment_d_succ_succ
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i j : ℕ) :
  (augment C f w).d (i+1) (j+1) = C.d i j :=
by { dsimp [augment], rcases i with _|i, refl, refl, }

/--
Truncating an augmented chain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncate_augment (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
  truncate.obj (augment C f w) ≅ C :=
{ hom :=
  { f := λ i, 𝟙 _, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { cases i; cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma truncate_augment_hom_f
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i : ℕ) :
  (truncate_augment C f w).hom.f i = 𝟙 (C.X i) := rfl
@[simp] lemma truncate_augment_inv_f
  (C : chain_complex V ℕ) {X : V} (f : C.X 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) (i : ℕ) :
  (truncate_augment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).X i) :=
by { cases i; refl, }

@[simp] lemma chain_complex_d_succ_succ_zero (C : chain_complex V ℕ) (i : ℕ) :
  C.d (i+2) 0 = 0 :=
by { rw C.shape, simpa using i.succ_succ_ne_one.symm }

/--
Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augment_truncate (C : chain_complex V ℕ) :
  augment (truncate.obj C) (C.d 1 0) (C.d_comp_d _ _ _) ≅ C :=
{ hom :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases i with _|_|i; cases j; { dsimp, simp, }, }, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases i with _|_|i; cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma augment_truncate_hom_f_zero (C : chain_complex V ℕ) :
  (augment_truncate C).hom.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_hom_f_succ (C : chain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).hom.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl
@[simp] lemma augment_truncate_inv_f_zero (C : chain_complex V ℕ) :
  (augment_truncate C).inv.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_inv_f_succ (C : chain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).inv.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl

/--
A chain map from a chain complex to a single object chain complex in degree zero
can be reinterpreted as a chain complex.

Ths is the inverse construction of `truncate_to`.
-/
def to_single₀_as_complex
  [has_zero_object V] (C : chain_complex V ℕ) (X : V) (f : C ⟶ (single₀ V).obj X) :
  chain_complex V ℕ :=
let ⟨f, w⟩ := to_single₀_equiv C X f in augment C f w

end chain_complex

namespace cochain_complex

/--
The truncation of a `ℕ`-indexed cochain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [has_zero_morphisms V] : cochain_complex V ℕ ⥤ cochain_complex V ℕ :=
{ obj := λ C,
  { X := λ i, C.X (i+1),
    d := λ i j, C.d (i+1) (j+1),
    shape' := λ i j w, by { apply C.shape, simpa }, },
  map := λ C D f,
  { f := λ i, f.f (i+1), }, }

/--
There is a canonical chain map from the truncation of a cochain complex `C` to
the "single object" cochain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 0 1` in degree 0, and zero otherwise.
-/
def to_truncate [has_zero_object V] [has_zero_morphisms V] (C : cochain_complex V ℕ) :
  (single₀ V).obj (C.X 0) ⟶ truncate.obj C :=
(from_single₀_equiv (truncate.obj C) (C.X 0)).symm ⟨C.d 0 1, by tidy⟩

variables [has_zero_morphisms V]

/--
We can "augment" a cochain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  cochain_complex V ℕ :=
{ X := λ i, match i with
  | 0 := X
  | (i+1) := C.X i
  end,
  d := λ i j, match i, j with
  | 0, 1 := f
  | (i+1), (j+1) := C.d i j
  | _, _ := 0
  end,
  shape' := λ i j s, begin
    simp at s,
    rcases j with _|_|j; cases i; unfold_aux; try { simp },
    { simpa using s, },
    { rw [C.shape], simp only [complex_shape.up_rel], contrapose! s, rw ←s },
  end,
  d_comp_d' := λ i j k hij hjk, begin
    rcases k with _|_|k; rcases j with _|_|j; cases i; unfold_aux; try { simp },
    cases k,
    { exact w, },
    { rw [C.shape, comp_zero],
      simp only [nat.nat_zero_eq_zero, complex_shape.up_rel, zero_add],
      exact (nat.one_lt_succ_succ _).ne },
  end, }

@[simp] lemma augment_X_zero
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  (augment C f w).X 0 = X := rfl

@[simp] lemma augment_X_succ
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (augment C f w).X (i+1) = C.X i := rfl

@[simp] lemma augment_d_zero_one
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  (augment C f w).d 0 1 = f := rfl

@[simp] lemma augment_d_succ_succ
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i j : ℕ) :
  (augment C f w).d (i+1) (j+1) = C.d i j :=
by { dsimp [augment], rcases i with _|i, refl, refl, }

/--
Truncating an augmented cochain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncate_augment (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) :
  truncate.obj (augment C f w) ≅ C :=
{ hom :=
  { f := λ i, 𝟙 _, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { cases i; cases j; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma truncate_augment_hom_f
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (truncate_augment C f w).hom.f i = 𝟙 (C.X i) := rfl
@[simp] lemma truncate_augment_inv_f
  (C : cochain_complex V ℕ) {X : V} (f : X ⟶ C.X 0) (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
  (truncate_augment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).X i) :=
by { cases i; refl, }

@[simp] lemma cochain_complex_d_succ_succ_zero (C : cochain_complex V ℕ) (i : ℕ) :
  C.d 0 (i+2) = 0 :=
by { rw C.shape, simp only [complex_shape.up_rel, zero_add], exact (nat.one_lt_succ_succ _).ne }

/--
Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augment_truncate (C : cochain_complex V ℕ) :
  augment (truncate.obj C) (C.d 0 1) (C.d_comp_d _ _ _) ≅ C :=
{ hom :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases j with _|_|j; cases i; { dsimp, simp, }, }, },
  inv :=
  { f := λ i, by { cases i; exact 𝟙 _, },
    comm' := λ i j, by { rcases j with _|_|j; cases i; { dsimp, simp, }, }, },
  hom_inv_id' := by { ext i, cases i; { dsimp, simp, }, },
  inv_hom_id' := by { ext i, cases i; { dsimp, simp, }, }, }.

@[simp] lemma augment_truncate_hom_f_zero (C : cochain_complex V ℕ) :
  (augment_truncate C).hom.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_hom_f_succ (C : cochain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).hom.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl
@[simp] lemma augment_truncate_inv_f_zero (C : cochain_complex V ℕ) :
  (augment_truncate C).inv.f 0 = 𝟙 (C.X 0) :=
rfl
@[simp] lemma augment_truncate_inv_f_succ (C : cochain_complex V ℕ) (i : ℕ) :
  (augment_truncate C).inv.f (i+1) = 𝟙 (C.X (i+1)) :=
rfl

/--
A chain map from a single object cochain complex in degree zero to a cochain complex
can be reinterpreted as a cochain complex.

Ths is the inverse construction of `to_truncate`.
-/
def from_single₀_as_complex
  [has_zero_object V] (C : cochain_complex V ℕ) (X : V) (f : (single₀ V).obj X ⟶ C) :
  cochain_complex V ℕ :=
let ⟨f, w⟩ := from_single₀_equiv C X f in augment C f w

end cochain_complex