/-
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 algebra.divisibility
import data.set.basic

/-!
# 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`
-/
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

set_option old_structure_cmd true
open function

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

/-- A typeclass stating that multiplication is left and right distributive
over addition. -/
@[protect_proj, ancestor has_mul has_add]
class distrib (R : Type*) extends has_mul R, has_add R :=
(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))

lemma left_distrib [distrib R] (a b c : R) : a * (b + c) = a * b + a * c :=
distrib.left_distrib a b c

alias left_distrib ← mul_add

lemma right_distrib [distrib R] (a b c : R) : (a + b) * c = a * c + b * c :=
distrib.right_distrib a b c

alias right_distrib ← add_mul

/-- Pullback a `distrib` instance along an injective function. -/
protected def function.injective.distrib {S} [has_mul R] [has_add R] [distrib S]
  (f : R → S) (hf : injective f) (add : ∀ x y, f (x + y) = f x + f y)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  distrib R :=
{ mul := (*),
  add := (+),
  left_distrib := λ x y z, hf $ by simp only [*, left_distrib],
  right_distrib := λ x y z, hf $ by simp only [*, right_distrib] }

/-- Pushforward a `distrib` instance along a surjective function. -/
protected def function.surjective.distrib {S} [distrib R] [has_add S] [has_mul S]
  (f : R → S) (hf : surjective f) (add : ∀ x y, f (x + y) = f x + f y)
  (mul : ∀ x y, f (x * y) = f x * f y) :
  distrib S :=
{ mul := (*),
  add := (+),
  left_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, left_distrib],
  right_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, right_distrib] }

/-!
### 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`. -/
@[protect_proj, ancestor add_comm_monoid monoid_with_zero distrib]
class semiring (α : Type u) extends add_comm_monoid α, monoid_with_zero α, distrib α

section semiring
variables [semiring α]

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.injective.semiring [has_zero β] [has_one β] [has_add β] [has_mul β]
  (f : β → α) (hf : 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 β :=
{ .. hf.monoid_with_zero f zero one mul, .. hf.add_comm_monoid f zero add,
  .. hf.distrib f add mul }

/-- Pushforward a `semiring` instance along a surjective function. -/
protected def function.surjective.semiring [has_zero β] [has_one β] [has_add β] [has_mul β]
  (f : α → β) (hf : 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 β :=
{ .. hf.monoid_with_zero f zero one mul, .. hf.add_comm_monoid f zero add,
  .. hf.distrib f add mul }

lemma one_add_one_eq_two : 1 + 1 = (2 : α) :=
by unfold bit0

theorem two_mul (n : α) : 2 * n = n + n :=
eq.trans (right_distrib 1 1 n) (by simp)

lemma distrib_three_right (a b c d : α) : (a + b + c) * d = a * d + b * d + c * d :=
by simp [right_distrib]

theorem mul_two (n : α) : n * 2 = n + n :=
(left_distrib n 1 1).trans (by simp)

theorem bit0_eq_two_mul (n : α) : bit0 n = 2 * n :=
(two_mul _).symm

@[to_additive] lemma mul_ite {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) :
  a * (if P then b else c) = if P then a * b else a * c :=
by split_ifs; refl

@[to_additive] lemma ite_mul {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) :
  (if P then a else b) * c = if P then a * c else b * c :=
by split_ifs; refl

-- 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`.
attribute [simp] mul_ite ite_mul

@[simp] lemma mul_boole {α} [semiring α] (P : Prop) [decidable P] (a : α) :
  a * (if P then 1 else 0) = if P then a else 0 :=
by simp

@[simp] lemma boole_mul {α} [semiring α] (P : Prop) [decidable P] (a : α) :
  (if P then 1 else 0) * a = if P then a else 0 :=
by simp

lemma ite_mul_zero_left {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) :
  ite P (a * b) 0 = ite P a 0 * b :=
by { by_cases h : P; simp [h], }

lemma ite_mul_zero_right {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) :
  ite P (a * b) 0 = a * ite P b 0 :=
by { by_cases h : P; simp [h], }

/-- An element `a` of a semiring is even if there exists `k` such `a = 2*k`. -/
def even (a : α) : Prop := ∃ k, a = 2*k

lemma even_iff_two_dvd {a : α} : even a ↔ 2 ∣ a := iff.rfl

@[simp] lemma range_two_mul (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x) = {a | even a} :=
by { ext x, simp [even, eq_comm] }

@[simp] lemma even_bit0 (a : α) : even (bit0 a) :=
⟨a, by rw [bit0, two_mul]⟩

/-- An element `a` of a semiring is odd if there exists `k` such `a = 2*k + 1`. -/
def odd (a : α) : Prop := ∃ k, a = 2*k + 1

@[simp] lemma odd_bit1 (a : α) : odd (bit1 a) :=
⟨a, by rw [bit1, bit0, two_mul]⟩

@[simp] lemma range_two_mul_add_one (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x + 1) = {a | odd a} :=
by { ext x, simp [odd, eq_comm] }

theorem dvd_add {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c :=
dvd.elim h₁ (λ d hd, dvd.elim h₂ (λ e he, dvd.intro (d + e) (by simp [left_distrib, hd, he])))

end semiring

namespace add_monoid_hom

/-- Left multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_left {R : Type*} [semiring R] (r : R) : R →+ R :=
{ to_fun := (*) r,
  map_zero' := mul_zero r,
  map_add' := mul_add r }

@[simp] lemma coe_mul_left {R : Type*} [semiring R] (r : R) : ⇑(mul_left r) = (*) r := rfl

/-- Right multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mul_right {R : Type*} [semiring R] (r : R) : R →+ R :=
{ to_fun := λ a, a * r,
  map_zero' := zero_mul r,
  map_add' := λ _ _, add_mul _ _ r }

@[simp] lemma coe_mul_right {R : Type*} [semiring R] (r : R) :
  ⇑(mul_right r) = (* r) := rfl

lemma mul_right_apply {R : Type*} [semiring R] (a r : R) :
  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*) (β : Type*) [semiring α] [semiring β]
  extends monoid_hom α β, add_monoid_hom α β, monoid_with_zero_hom α β

infixr ` →+* `:25 := 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)`. -/
add_decl_doc ring_hom.to_monoid_with_zero_hom

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

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

namespace ring_hom

section coe

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

include rα rβ

instance : has_coe_to_fun (α →+* β) := ⟨_, ring_hom.to_fun⟩

initialize_simps_projections ring_hom (to_fun → apply)

@[simp] lemma to_fun_eq_coe (f : α →+* β) : f.to_fun = f := rfl

@[simp] lemma coe_mk (f : α → β) (h₁ h₂ h₃ h₄) : ⇑(⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) = f := rfl

instance has_coe_monoid_hom : has_coe (α →+* β) (α →* β) := ⟨ring_hom.to_monoid_hom⟩

@[simp, norm_cast] lemma coe_monoid_hom (f : α →+* β) : ⇑(f : α →* β) = f := rfl

@[simp] lemma to_monoid_hom_eq_coe (f : α →+* β) : f.to_monoid_hom = f := rfl
@[simp] lemma to_monoid_with_zero_hom_eq_coe (f : α →+* β) :
  (f.to_monoid_with_zero_hom : α → β) = f := rfl

@[simp] lemma coe_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) :
  ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →* β) = ⟨f, h₁, h₂⟩ :=
rfl

instance has_coe_add_monoid_hom : has_coe (α →+* β) (α →+ β) := ⟨ring_hom.to_add_monoid_hom⟩

@[simp, norm_cast] lemma coe_add_monoid_hom (f : α →+* β) : ⇑(f : α →+ β) = f := rfl

@[simp] lemma to_add_monoid_hom_eq_coe (f : α →+* β) : f.to_add_monoid_hom = f := rfl

@[simp] lemma coe_add_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) :
  ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →+ β) = ⟨f, h₃, h₄⟩ :=
rfl

end coe

variables [rα : semiring α] [rβ : semiring β]

section
include rα rβ

variables (f : α →+* β) {x y : α} {rα rβ}

theorem congr_fun {f g : α →+* β} (h : f = g) (x : α) : f x = g x :=
congr_arg (λ h : α →+* β, h x) h

theorem congr_arg (f : α →+* β) {x y : α} (h : x = y) : f x = f y :=
congr_arg (λ x : α, f x) h

theorem coe_inj ⦃f g : α →+* β⦄ (h : (f : α → β) = g) : f = g :=
by cases f; cases g; cases h; refl

@[ext] theorem ext ⦃f g : α →+* β⦄ (h : ∀ x, f x = g x) : f = g :=
coe_inj (funext h)

theorem ext_iff {f g : α →+* β} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

@[simp] lemma mk_coe (f : α →+* β) (h₁ h₂ h₃ h₄) : ring_hom.mk f h₁ h₂ h₃ h₄ = f :=
ext $ λ _, rfl

theorem coe_add_monoid_hom_injective : function.injective (coe : (α →+* β) → (α →+ β)) :=
λ f g h, ext (λ x, add_monoid_hom.congr_fun h x)

theorem coe_monoid_hom_injective : function.injective (coe : (α →+* β) → (α →* β)) :=
λ f g h, ext (λ x, monoid_hom.congr_fun h x)

/-- Ring homomorphisms map zero to zero. -/
@[simp] lemma map_zero (f : α →+* β) : f 0 = 0 := f.map_zero'

/-- Ring homomorphisms map one to one. -/
@[simp] lemma map_one (f : α →+* β) : f 1 = 1 := f.map_one'

/-- Ring homomorphisms preserve addition. -/
@[simp] lemma map_add (f : α →+* β) (a b : α) : f (a + b) = f a + f b := f.map_add' a b

/-- Ring homomorphisms preserve multiplication. -/
@[simp] lemma map_mul (f : α →+* β) (a b : α) : f (a * b) = f a * f b := f.map_mul' a b

/-- Ring homomorphisms preserve `bit0`. -/
@[simp] lemma map_bit0 (f : α →+* β) (a : α) : f (bit0 a) = bit0 (f a) := map_add _ _ _

/-- Ring homomorphisms preserve `bit1`. -/
@[simp] lemma map_bit1 (f : α →+* β) (a : α) : f (bit1 a) = bit1 (f a) :=
by simp [bit1]

/-- `f : R →+* S` has a trivial codomain iff `f 1 = 0`. -/
lemma codomain_trivial_iff_map_one_eq_zero : (0 : β) = 1 ↔ f 1 = 0 :=
by rw [map_one, eq_comm]

/-- `f : R →+* S` has a trivial codomain iff it has a trivial range. -/
lemma codomain_trivial_iff_range_trivial : (0 : β) = 1 ↔ (∀ x, f x = 0) :=
f.codomain_trivial_iff_map_one_eq_zero.trans
  ⟨λ h x, by rw [←mul_one x, map_mul, h, mul_zero], λ h, h 1⟩

/-- `f : R →+* S` has a trivial codomain iff its range is `{0}`. -/
lemma codomain_trivial_iff_range_eq_singleton_zero : (0 : β) = 1 ↔ set.range f = {0} :=
f.codomain_trivial_iff_range_trivial.trans
  ⟨ λ h, set.ext (λ y, ⟨λ ⟨x, hx⟩, by simp [←hx, h x], λ hy, ⟨0, by simpa using hy.symm⟩⟩),
    λ h x, set.mem_singleton_iff.mp (h ▸ set.mem_range_self x)⟩

/-- `f : R →+* S` doesn't map `1` to `0` if `S` is nontrivial -/
lemma map_one_ne_zero [nontrivial β] : f 1 ≠ 0 :=
mt f.codomain_trivial_iff_map_one_eq_zero.mpr zero_ne_one

/-- If there is a homomorphism `f : R →+* S` and `S` is nontrivial, then `R` is nontrivial. -/
lemma domain_nontrivial [nontrivial β] : nontrivial α :=
⟨⟨1, 0, mt (λ h, show f 1 = 0, by rw [h, map_zero]) f.map_one_ne_zero⟩⟩

lemma is_unit_map (f : α →+* β) {a : α} (h : is_unit a) : is_unit (f a) :=
h.map (f.to_monoid_hom)

end

/-- The identity ring homomorphism from a semiring to itself. -/
def id (α : Type*) [semiring α] : α →+* α :=
by refine {to_fun := id, ..}; intros; refl

include rα

instance : inhabited (α →+* α) := ⟨id α⟩

@[simp] lemma id_apply (x : α) : ring_hom.id α x = x := rfl

variable {rγ : semiring γ}
include rβ rγ

/-- Composition of ring homomorphisms is a ring homomorphism. -/
def comp (hnp : β →+* γ) (hmn : α →+* β) : α →+* γ :=
{ to_fun := hnp ∘ hmn,
  map_zero' := by simp,
  map_one' := by simp,
  map_add' := λ x y, by simp,
  map_mul' := λ x y, by simp}

/-- Composition of semiring homomorphisms is associative. -/
lemma comp_assoc {δ} {rδ: semiring δ} (f : α →+* β) (g : β →+* γ) (h : γ →+* δ) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

@[simp] lemma coe_comp (hnp : β →+* γ) (hmn : α →+* β) : (hnp.comp hmn : α → γ) = hnp ∘ hmn := rfl

lemma comp_apply (hnp : β →+* γ) (hmn : α →+* β) (x : α) : (hnp.comp hmn : α → γ) x =
  (hnp (hmn x)) := rfl

omit rγ

@[simp] lemma comp_id (f : α →+* β) : f.comp (id α) = f := ext $ λ x, rfl

@[simp] lemma id_comp (f : α →+* β) : (id β).comp f = f := ext $ λ x, rfl

omit rβ

instance : monoid (α →+* α) :=
{ one := id α,
  mul := comp,
  mul_one := comp_id,
  one_mul := id_comp,
  mul_assoc := λ f g h, comp_assoc _ _ _ }

lemma one_def : (1 : α →+* α) = id α := rfl

@[simp] lemma coe_one : ⇑(1 : α →+* α) = _root_.id := rfl

lemma mul_def (f g : α →+* α) : f * g = f.comp g := rfl

@[simp] lemma coe_mul (f g : α →+* α) : ⇑(f * g) = f ∘ g := rfl

include rβ rγ

lemma cancel_right {g₁ g₂ : β →+* γ} {f : α →+* β} (hf : surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, ring_hom.ext $ (forall_iff_forall_surj hf).1 (ext_iff.1 h), λ h, h ▸ rfl⟩

lemma cancel_left {g : β →+* γ} {f₁ f₂ : α →+* β} (hg : injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, ring_hom.ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩

omit rα rβ rγ

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`). -/
@[protect_proj, ancestor semiring comm_monoid]
class comm_semiring (α : Type u) extends semiring α, comm_monoid α

@[priority 100] -- see Note [lower instance priority]
instance comm_semiring.to_comm_monoid_with_zero [comm_semiring α] : comm_monoid_with_zero α :=
{ .. comm_semiring.to_comm_monoid α, .. comm_semiring.to_semiring α }

section comm_semiring
variables [comm_semiring α] [comm_semiring β] {a b c : α}

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.injective.comm_semiring [has_zero γ] [has_one γ] [has_add γ] [has_mul γ]
  (f : γ → α) (hf : 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 γ :=
{ .. hf.semiring f zero one add mul, .. hf.comm_semigroup f mul }

/-- Pullback a `semiring` instance along an injective function. -/
protected def function.surjective.comm_semiring [has_zero γ] [has_one γ] [has_add γ] [has_mul γ]
  (f : α → γ) (hf : 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 γ :=
{ .. hf.semiring f zero one add mul, .. hf.comm_semigroup f mul }

lemma add_mul_self_eq (a b : α) : (a + b) * (a + b) = a*a + 2*a*b + b*b :=
by simp only [two_mul, add_mul, mul_add, add_assoc, mul_comm b]

@[simp] theorem two_dvd_bit0 : 2 ∣ bit0 a := ⟨a, bit0_eq_two_mul _⟩

lemma ring_hom.map_dvd (f : α →+* β) {a b : α} : a ∣ b → f a ∣ f b :=
λ ⟨z, hz⟩, ⟨f z, by rw [hz, f.map_mul]⟩

end comm_semiring

/-!
### 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.  -/
@[protect_proj, ancestor add_comm_group monoid distrib]
class ring (α : Type u) extends add_comm_group α, monoid α, distrib α

section ring
variables [ring α] {a b c d e : α}

/- 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. -/
@[priority 200]
instance ring.to_semiring : semiring α :=
{ zero_mul := λ a, add_left_cancel $ show 0 * a + 0 * a = 0 * a + 0,
    by rw [← add_mul, zero_add, add_zero],
  mul_zero := λ a, add_left_cancel $ show a * 0 + a * 0 = a * 0 + 0,
    by rw [← mul_add, add_zero, add_zero],
  ..‹ring α› }

/-- Pullback a `ring` instance along an injective function. -/
protected def function.injective.ring
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : 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 β :=
{ .. hf.add_comm_group f zero add neg sub, .. hf.monoid f one mul, .. hf.distrib f add mul }

/-- Pullback a `ring` instance along an injective function. -/
protected def function.surjective.ring
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : α → β) (hf : 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 β :=
{ .. hf.add_comm_group f zero add neg sub, .. hf.monoid f one mul, .. hf.distrib f add mul }

lemma neg_mul_eq_neg_mul (a b : α) : -(a * b) = -a * b :=
neg_eq_of_add_eq_zero
  begin rw [← right_distrib, add_right_neg, zero_mul] end

lemma neg_mul_eq_mul_neg (a b : α) : -(a * b) = a * -b :=
neg_eq_of_add_eq_zero
  begin rw [← left_distrib, add_right_neg, mul_zero] end

@[simp] lemma neg_mul_eq_neg_mul_symm (a b : α) : - a * b = - (a * b) :=
eq.symm (neg_mul_eq_neg_mul a b)

@[simp] lemma mul_neg_eq_neg_mul_symm (a b : α) : a * - b = - (a * b) :=
eq.symm (neg_mul_eq_mul_neg a b)

lemma neg_mul_neg (a b : α) : -a * -b = a * b :=
by simp

lemma neg_mul_comm (a b : α) : -a * b = a * -b :=
by simp

theorem neg_eq_neg_one_mul (a : α) : -a = -1 * a :=
by simp

lemma mul_sub_left_distrib (a b c : α) : a * (b - c) = a * b - a * c :=
by simpa only [sub_eq_add_neg, neg_mul_eq_mul_neg] using mul_add a b (-c)

alias mul_sub_left_distrib ← mul_sub

lemma mul_sub_right_distrib (a b c : α) : (a - b) * c = a * c - b * c :=
by simpa only [sub_eq_add_neg, neg_mul_eq_neg_mul] using add_mul a (-b) c

alias mul_sub_right_distrib ← sub_mul

/-- An element of a ring multiplied by the additive inverse of one is the element's additive
  inverse. -/
lemma mul_neg_one (a : α) : a * -1 = -a := by simp

/-- The additive inverse of one multiplied by an element of a ring is the element's additive
  inverse. -/
lemma neg_one_mul (a : α) : -1 * a = -a := by simp

/-- 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 : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
calc
  a * e + c = b * e + d ↔ a * e + c = d + b * e : by simp [add_comm]
    ... ↔ a * e + c - b * e = d : iff.intro (λ h, begin rw h, simp end) (λ h,
                                                  begin rw ← h, simp end)
    ... ↔ (a - b) * e + c = d   : begin simp [sub_mul, sub_add_eq_add_sub] end

/-- 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 : a * e + c = b * e + d → (a - b) * e + c = d :=
assume h,
calc
  (a - b) * e + c = (a * e + c) - b * e : begin simp [sub_mul, sub_add_eq_add_sub] end
              ... = d                   : begin rw h, simp [@add_sub_cancel α] end

end ring

namespace units
variables [ring α] {a b : α}

/-- Each element of the group of units of a ring has an additive inverse. -/
instance : has_neg (units α) := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩

/-- 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, norm_cast] protected theorem coe_neg (u : units α) : (↑-u : α) = -u := rfl

@[simp, norm_cast] protected theorem coe_neg_one : ((-1 : units α) : α) = -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 (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 (u : units α) : - -u = u :=
units.ext $ neg_neg _

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

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

/-- 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 (u₁ u₂ : units α) : -u₁ * -u₂ = u₁ * u₂ := by simp

/-- 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 (u : units α) : -u = -1 * u := by simp

end units

lemma is_unit.neg [ring α] {a : α} : is_unit a → is_unit (-a)
| ⟨x, hx⟩ := hx ▸ (-x).is_unit

namespace ring_hom

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

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

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

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

end ring_hom

/-- A commutative ring is a `ring` with commutative multiplication. -/
@[protect_proj, ancestor ring comm_semigroup]
class comm_ring (α : Type u) extends ring α, comm_monoid α

@[priority 100] -- see Note [lower instance priority]
instance comm_ring.to_comm_semiring [s : comm_ring α] : comm_semiring α :=
{ mul_zero := mul_zero, zero_mul := zero_mul, ..s }

section comm_ring
variables [comm_ring α] {a b c : α}

/-- Pullback a `comm_ring` instance along an injective function. -/
protected def function.injective.comm_ring
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : 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 β :=
{ .. hf.ring f zero one add mul neg sub, .. hf.comm_semigroup f mul }

/-- Pullback a `comm_ring` instance along an injective function. -/
protected def function.surjective.comm_ring
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : α → β) (hf : 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 β :=
{ .. hf.ring f zero one add mul neg sub, .. hf.comm_semigroup f mul }

local attribute [simp] add_assoc add_comm add_left_comm mul_comm

theorem dvd_neg_of_dvd (h : a ∣ b) : (a ∣ -b) :=
dvd.elim h
  (assume c, assume : b = a * c,
    dvd.intro (-c) (by simp [this]))

theorem dvd_of_dvd_neg (h : a ∣ -b) : (a ∣ b) :=
let t := dvd_neg_of_dvd h in by rwa neg_neg at t

theorem dvd_neg_iff_dvd (a b : α) : (a ∣ -b) ↔ (a ∣ b) :=
⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩

theorem neg_dvd_of_dvd (h : a ∣ b) : -a ∣ b :=
dvd.elim h
  (assume c, assume : b = a * c,
    dvd.intro (-c) (by simp [this]))

theorem dvd_of_neg_dvd (h : -a ∣ b) : a ∣ b :=
let t := neg_dvd_of_dvd h in by rwa neg_neg at t

theorem neg_dvd_iff_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) :=
⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩

theorem dvd_sub (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c :=
by { rw sub_eq_add_neg, exact dvd_add h₁ (dvd_neg_of_dvd h₂) }

theorem dvd_add_iff_left (h : a ∣ c) : a ∣ b ↔ a ∣ b + c :=
⟨λh₂, dvd_add h₂ h, λH, by have t := dvd_sub H h; rwa add_sub_cancel at t⟩

theorem dvd_add_iff_right (h : a ∣ b) : a ∣ c ↔ a ∣ b + c :=
by rw add_comm; exact dvd_add_iff_left h

theorem two_dvd_bit1 : 2 ∣ bit1 a ↔ (2 : α) ∣ 1 := (dvd_add_iff_right (@two_dvd_bit0 _ _ a)).symm

/-- Representation of a difference of two squares in a commutative ring as a product. -/
theorem mul_self_sub_mul_self (a b : α) : a * a - b * b = (a + b) * (a - b) :=
by rw [add_mul, mul_sub, mul_sub, mul_comm a b, sub_add_sub_cancel]

lemma mul_self_sub_one (a : α) : a * a - 1 = (a + 1) * (a - 1) :=
by rw [← mul_self_sub_mul_self, mul_one]

/-- An element a of a commutative ring divides the additive inverse of an element b iff a
  divides b. -/
@[simp] lemma dvd_neg (a b : α) : (a ∣ -b) ↔ (a ∣ b) :=
⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩

/-- The additive inverse of an element a of a commutative ring divides another element b iff a
  divides b. -/
@[simp] lemma neg_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) :=
⟨dvd_of_neg_dvd, 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 (h : a ∣ c) : a ∣ b + c ↔ a ∣ b :=
(dvd_add_iff_left h).symm

/-- 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 (h : a ∣ b) : a ∣ b + c ↔ a ∣ c :=
(dvd_add_iff_right h).symm

/-- An element a divides the sum a + b if and only if a divides b.-/
@[simp] lemma dvd_add_self_left {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] lemma dvd_add_self_right {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. -/
lemma Vieta_formula_quadratic {b c x : α} (h : x * x - b * x + c = 0) :
  ∃ y : α, y * y - b * y + c = 0 ∧ x + y = b ∧ x * y = c :=
begin
  have : c = -(x * x - b * x) := (neg_eq_of_add_eq_zero h).symm,
  have : c = x * (b - x), by subst this; simp [mul_sub, mul_comm],
  refine ⟨b - x, _, by simp, by rw this⟩,
  rw [this, sub_add, ← sub_mul, sub_self]
end

lemma dvd_mul_sub_mul {k a b x y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) :
  k ∣ a * x - b * y :=
begin
  convert dvd_add (dvd_mul_of_dvd_right hxy a) (dvd_mul_of_dvd_left hab y),
  rw [mul_sub_left_distrib, mul_sub_right_distrib],
  simp only [sub_eq_add_neg, add_assoc, neg_add_cancel_left],
end

lemma dvd_iff_dvd_of_dvd_sub {a b c : α} (h : a ∣ (b - c)) : (a ∣ b ↔ a ∣ c) :=
begin
  split,
  { intro h',
    convert dvd_sub h' h,
    exact eq.symm (sub_sub_self b c) },
  { intro h',
    convert dvd_add h h',
    exact eq_add_of_sub_eq rfl }
end

end comm_ring

lemma succ_ne_self [ring α] [nontrivial α] (a : α) : a + 1 ≠ a :=
λ h, one_ne_zero ((add_right_inj a).mp (by simp [h]))

lemma pred_ne_self [ring α] [nontrivial α] (a : α) : a - 1 ≠ a :=
λ h, one_ne_zero (neg_injective ((add_right_inj a).mp (by simpa [sub_eq_add_neg] using h)))

/-- 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. -/
@[protect_proj] class domain (α : Type u) extends ring α, nontrivial α :=
(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ a b : α, a * b = 0 → a = 0 ∨ b = 0)

section domain
variable [domain α]

@[priority 100] -- see Note [lower instance priority]
instance domain.to_no_zero_divisors : no_zero_divisors α :=
⟨domain.eq_zero_or_eq_zero_of_mul_eq_zero⟩

@[priority 100] -- see Note [lower instance priority]
instance domain.to_cancel_monoid_with_zero : cancel_monoid_with_zero α :=
{ mul_left_cancel_of_ne_zero := λ a b c ha,
    by { rw [← sub_eq_zero, ← mul_sub], simp [ha, sub_eq_zero] },
  mul_right_cancel_of_ne_zero := λ a b c hb,
    by { rw [← sub_eq_zero, ← sub_mul], simp [hb, sub_eq_zero] },
  .. (infer_instance : semiring α) }

/-- Pullback a `domain` instance along an injective function. -/
protected def function.injective.domain [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β]
  [has_sub β] (f : β → α) (hf : 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) :
  domain β :=
{ .. hf.ring f zero one add mul neg sub, .. pullback_nonzero f zero one,
  .. hf.no_zero_divisors f zero mul }

end domain

/-!
### 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. -/
@[protect_proj, ancestor comm_ring domain]
class integral_domain (α : Type u) extends comm_ring α, domain α

section integral_domain
variables [integral_domain α] {a b c d e : α}

@[priority 100] -- see Note [lower instance priority]
instance integral_domain.to_comm_cancel_monoid_with_zero : comm_cancel_monoid_with_zero α :=
{ ..comm_semiring.to_comm_monoid_with_zero, ..domain.to_cancel_monoid_with_zero }

/-- Pullback an `integral_domain` instance along an injective function. -/
protected def function.injective.integral_domain [has_zero β] [has_one β] [has_add β] [has_mul β]
  [has_neg β] [has_sub β] (f : β → α) (hf : 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) :
  integral_domain β :=
{ .. hf.comm_ring f zero one add mul neg sub, .. hf.domain f zero one add mul neg sub }

lemma mul_self_eq_mul_self_iff {a b : α} : a * a = b * b ↔ a = b ∨ a = -b :=
by rw [← sub_eq_zero, mul_self_sub_mul_self, mul_eq_zero, or_comm, sub_eq_zero,
  add_eq_zero_iff_eq_neg]

lemma mul_self_eq_one_iff {a : α} : a * a = 1 ↔ a = 1 ∨ a = -1 :=
by rw [← mul_self_eq_mul_self_iff, one_mul]

/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or
  one's additive inverse. -/
lemma units.inv_eq_self_iff (u : units α) : u⁻¹ = u ↔ u = 1 ∨ u = -1 :=
by { rw inv_eq_iff_mul_eq_one, simp only [units.ext_iff], push_cast, exact mul_self_eq_one_iff }

/--
Makes a ring homomorphism from an additive group homomorphism from a commutative ring to an integral
domain that commutes with self multiplication, assumes that two is nonzero and one is sent to one.
-/
def add_monoid_hom.mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β] (f : β →+ α)
  (h : ∀ x, f (x * x) = f x * f x) (h_two : (2 : α) ≠ 0) (h_one : f 1 = 1) : β →+* α :=
{ map_one' := h_one,
  map_mul' := begin
    intros x y,
    have hxy := h (x + y),
    rw [mul_add, add_mul, add_mul, f.map_add, f.map_add, f.map_add, f.map_add, h x, h y, add_mul,
      mul_add, mul_add, ← sub_eq_zero, add_comm, ← sub_sub, ← sub_sub, ← sub_sub,
      mul_comm y x, mul_comm (f y) (f x)] at hxy,
    simp only [add_assoc, add_sub_assoc, add_sub_cancel'_right] at hxy,
    rw [sub_sub, ← two_mul, ← add_sub_assoc, ← two_mul, ← mul_sub, mul_eq_zero, sub_eq_zero,
      or_iff_not_imp_left] at hxy,
    exact hxy h_two,
  end,
  ..f }

@[simp]
lemma add_monoid_hom.coe_fn_mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β] (f : β →+ α)
  (h h_two h_one) :
  (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β → α) = f := rfl

@[simp]
lemma add_monoid_hom.coe_add_monoid_hom_mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β]
  (f : β →+ α) (h h_two h_one) :
  (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β →+ α) = f := by {ext, simp}

end integral_domain

namespace ring
variables {M₀ : Type*} [monoid_with_zero M₀]
open_locale classical

/-- Introduce a function `inverse` on a monoid with zero `M₀`, 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.

Note that while this is in the `ring` namespace for brevity, it requires the weaker assumption
`monoid_with_zero M₀` instead of `ring M₀`. -/
noncomputable def inverse : M₀ → M₀ :=
λ x, if h : is_unit x then (((classical.some h)⁻¹ : units M₀) : M₀) else 0

/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/
@[simp] lemma inverse_unit (u : units M₀) : inverse (u : M₀) = (u⁻¹ : units M₀) :=
begin
  simp only [units.is_unit, inverse, dif_pos],
  exact units.inv_unique (classical.some_spec u.is_unit)
end

/-- By definition, if `x` is not invertible then `inverse x = 0`. -/
@[simp] lemma inverse_non_unit (x : M₀) (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 : Prop :=
(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
attribute [nolint def_lemma doc_blame] is_integral_domain.to_nontrivial

/-- Every integral domain satisfies the predicate for integral domains. -/
lemma integral_domain.to_is_integral_domain (R : Type u) [integral_domain R] :
  is_integral_domain R :=
{ .. (‹_› : integral_domain R) }

/-- 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 :=
{ .. (‹_› : ring R), .. (‹_› : is_integral_domain R) }

namespace semiconj_by

@[simp] lemma add_right [distrib R] {a x y x' y' : R}
  (h : semiconj_by a x y) (h' : semiconj_by a x' y') :
  semiconj_by a (x + x') (y + y') :=
by simp only [semiconj_by, left_distrib, right_distrib, h.eq, h'.eq]

@[simp] lemma add_left [distrib R] {a b x y : R}
  (ha : semiconj_by a x y) (hb : semiconj_by b x y) :
  semiconj_by (a + b) x y :=
by simp only [semiconj_by, left_distrib, right_distrib, ha.eq, hb.eq]

variables [ring R] {a b x y x' y' : R}

lemma neg_right (h : semiconj_by a x y) : semiconj_by a (-x) (-y) :=
by simp only [semiconj_by, h.eq, neg_mul_eq_neg_mul_symm, mul_neg_eq_neg_mul_symm]

@[simp] lemma neg_right_iff : semiconj_by a (-x) (-y) ↔ semiconj_by a x y :=
⟨λ h, neg_neg x ▸ neg_neg y ▸ h.neg_right, semiconj_by.neg_right⟩

lemma neg_left (h : semiconj_by a x y) : semiconj_by (-a) x y :=
by simp only [semiconj_by, h.eq, neg_mul_eq_neg_mul_symm, mul_neg_eq_neg_mul_symm]

@[simp] lemma neg_left_iff : semiconj_by (-a) x y ↔ semiconj_by a x y :=
⟨λ h, neg_neg a ▸ h.neg_left, semiconj_by.neg_left⟩

@[simp] lemma neg_one_right (a : R) : semiconj_by a (-1) (-1) :=
(one_right a).neg_right

@[simp] lemma neg_one_left (x : R) : semiconj_by (-1) x x :=
(semiconj_by.one_left x).neg_left

@[simp] lemma sub_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') :
  semiconj_by a (x - x') (y - y') :=
by simpa only [sub_eq_add_neg] using h.add_right h'.neg_right

@[simp] lemma sub_left (ha : semiconj_by a x y) (hb : semiconj_by b x y) :
  semiconj_by (a - b) x y :=
by simpa only [sub_eq_add_neg] using ha.add_left hb.neg_left

end semiconj_by

namespace commute

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

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

lemma bit0_right [distrib R] {x y : R} (h : commute x y) : commute x (bit0 y) :=
h.add_right h

lemma bit0_left [distrib R] {x y : R} (h : commute x y) : commute (bit0 x) y :=
h.add_left h

lemma bit1_right [semiring R] {x y : R} (h : commute x y) : commute x (bit1 y) :=
h.bit0_right.add_right (commute.one_right x)

lemma bit1_left [semiring R] {x y : R} (h : commute x y) : commute (bit1 x) y :=
h.bit0_left.add_left (commute.one_left y)

variables [ring R] {a b c : R}

theorem neg_right : commute a b → commute a (- b) := semiconj_by.neg_right
@[simp] theorem neg_right_iff : commute a (-b) ↔ commute a b := semiconj_by.neg_right_iff

theorem neg_left : commute a b → commute (- a) b := semiconj_by.neg_left
@[simp] theorem neg_left_iff : commute (-a) b ↔ commute a b := semiconj_by.neg_left_iff

@[simp] theorem neg_one_right (a : R) : commute a (-1) := semiconj_by.neg_one_right a
@[simp] theorem neg_one_left (a : R): commute (-1) a := semiconj_by.neg_one_left a

@[simp] theorem sub_right : commute a b → commute a c → commute a (b - c) := semiconj_by.sub_right
@[simp] theorem sub_left : commute a c → commute b c → commute (a - b) c := semiconj_by.sub_left

end commute


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

Bases of topologies. Countability axioms.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.continuous_on
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

namespace topological_space

/- countability axioms

For our applications we are interested that there exists a countable basis, but we do not need the
concrete basis itself. This allows us to declare these type classes as `Prop` to use them as mixins.
-/

/-- A topological basis is one that satisfies the necessary conditions so that
  it suffices to take unions of the basis sets to get a topology (without taking
  finite intersections as well). -/
def is_topological_basis {α : Type u} [t : topological_space α] (s : set (set α)) :=
  (∀ (t₁ : set α) (H : t₁ ∈ s) (t₂ : set α) (H : t₂ ∈ s) (x : α) (H : x ∈ t₁ ∩ t₂),
      ∃ (t₃ : set α), ∃ (H : t₃ ∈ s), x ∈ t₃ ∧ t₃ ⊆ t₁ ∩ t₂) ∧
    ⋃₀s = set.univ ∧ t = generate_from s

theorem is_topological_basis_of_subbasis {α : Type u} [t : topological_space α] {s : set (set α)}
    (hs : t = generate_from s) :
    is_topological_basis
        ((fun (f : set (set α)) => ⋂₀f) ''
          set_of fun (f : set (set α)) => set.finite f ∧ f ⊆ s ∧ set.nonempty (⋂₀f)) :=
  sorry

theorem is_topological_basis_of_open_of_nhds {α : Type u} [t : topological_space α]
    {s : set (set α)} (h_open : ∀ (u : set α), u ∈ s → is_open u)
    (h_nhds :
      ∀ (a : α) (u : set α), a ∈ u → is_open u → ∃ (v : set α), ∃ (H : v ∈ s), a ∈ v ∧ v ⊆ u) :
    is_topological_basis s :=
  sorry

theorem mem_nhds_of_is_topological_basis {α : Type u} [t : topological_space α] {a : α} {s : set α}
    {b : set (set α)} (hb : is_topological_basis b) :
    s ∈ nhds a ↔ ∃ (t : set α), ∃ (H : t ∈ b), a ∈ t ∧ t ⊆ s :=
  sorry

theorem is_topological_basis.nhds_has_basis {α : Type u} [t : topological_space α] {b : set (set α)}
    (hb : is_topological_basis b) {a : α} :
    filter.has_basis (nhds a) (fun (t : set α) => t ∈ b ∧ a ∈ t) fun (t : set α) => t :=
  sorry

theorem is_open_of_is_topological_basis {α : Type u} [t : topological_space α] {s : set α}
    {b : set (set α)} (hb : is_topological_basis b) (hs : s ∈ b) : is_open s :=
  sorry

theorem mem_basis_subset_of_mem_open {α : Type u} [t : topological_space α] {b : set (set α)}
    (hb : is_topological_basis b) {a : α} {u : set α} (au : a ∈ u) (ou : is_open u) :
    ∃ (v : set α), ∃ (H : v ∈ b), a ∈ v ∧ v ⊆ u :=
  iff.mp (mem_nhds_of_is_topological_basis hb) (mem_nhds_sets ou au)

theorem sUnion_basis_of_is_open {α : Type u} [t : topological_space α] {B : set (set α)}
    (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
    ∃ (S : set (set α)), ∃ (H : S ⊆ B), u = ⋃₀S :=
  sorry

theorem Union_basis_of_is_open {α : Type u} [t : topological_space α] {B : set (set α)}
    (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
    ∃ (β : Type u), ∃ (f : β → set α), (u = set.Union fun (i : β) => f i) ∧ ∀ (i : β), f i ∈ B :=
  sorry

/-- A separable space is one with a countable dense subset, available through
`topological_space.exists_countable_dense`. If `α` is also known to be nonempty, then
`topological_space.dense_seq` provides a sequence `ℕ → α` with dense range, see
`topological_space.dense_range_dense_seq`.

If `α` is a uniform space with countably generated uniformity filter (e.g., an `emetric_space`),
then this condition is equivalent to `topological_space.second_countable_topology α`. In this case
the latter should be used as a typeclass argument in theorems because Lean can automatically deduce
`separable_space` from `second_countable_topology` but it can't deduce `second_countable_topology`
and `emetric_space`. -/
class separable_space (α : Type u) [t : topological_space α] where
  exists_countable_dense : ∃ (s : set α), set.countable s ∧ dense s

theorem exists_countable_dense (α : Type u) [t : topological_space α] [separable_space α] :
    ∃ (s : set α), set.countable s ∧ dense s :=
  separable_space.exists_countable_dense

/-- A nonempty separable space admits a sequence with dense range. Instead of running `cases` on the
conclusion of this lemma, you might want to use `topological_space.dense_seq` and
`topological_space.dense_range_dense_seq`.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
theorem exists_dense_seq (α : Type u) [t : topological_space α] [separable_space α] [Nonempty α] :
    ∃ (u : ℕ → α), dense_range u :=
  sorry

/-- A sequence dense in a non-empty separable topological space.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
def dense_seq (α : Type u) [t : topological_space α] [separable_space α] [Nonempty α] : ℕ → α :=
  classical.some (exists_dense_seq α)

/-- The sequence `dense_seq α` has dense range. -/
@[simp] theorem dense_range_dense_seq (α : Type u) [t : topological_space α] [separable_space α]
    [Nonempty α] : dense_range (dense_seq α) :=
  classical.some_spec (exists_dense_seq α)

end topological_space

/-- If `α` is a separable space and `f : α → β` is a continuous map with dense range, then `β` is
a separable space as well. E.g., the completion of a separable uniform space is separable. -/
protected theorem dense_range.separable_space {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space.separable_space α] [topological_space β] {f : α → β} (h : dense_range f)
    (h' : continuous f) : topological_space.separable_space β :=
  sorry

namespace topological_space

/-- A first-countable space is one in which every point has a
  countable neighborhood basis. -/
class first_countable_topology (α : Type u) [t : topological_space α] where
  nhds_generated_countable : ∀ (a : α), filter.is_countably_generated (nhds a)

namespace first_countable_topology

theorem tendsto_subseq {α : Type u} [t : topological_space α] [first_countable_topology α]
    {u : ℕ → α} {x : α} (hx : map_cluster_pt x filter.at_top u) :
    ∃ (ψ : ℕ → ℕ), strict_mono ψ ∧ filter.tendsto (u ∘ ψ) filter.at_top (nhds x) :=
  filter.is_countably_generated.subseq_tendsto (nhds_generated_countable x) hx

end first_countable_topology

theorem is_countably_generated_nhds {α : Type u} [t : topological_space α]
    [first_countable_topology α] (x : α) : filter.is_countably_generated (nhds x) :=
  first_countable_topology.nhds_generated_countable x

theorem is_countably_generated_nhds_within {α : Type u} [t : topological_space α]
    [first_countable_topology α] (x : α) (s : set α) :
    filter.is_countably_generated (nhds_within x s) :=
  filter.is_countably_generated.inf_principal (is_countably_generated_nhds x) s

/-- A second-countable space is one with a countable basis. -/
class second_countable_topology (α : Type u) [t : topological_space α] where
  is_open_generated_countable : ∃ (b : set (set α)), set.countable b ∧ t = generate_from b

protected instance second_countable_topology.to_first_countable_topology (α : Type u)
    [t : topological_space α] [second_countable_topology α] : first_countable_topology α :=
  sorry

theorem second_countable_topology_induced (α : Type u) (β : Type u_1) [t : topological_space β]
    [second_countable_topology β] (f : α → β) : second_countable_topology α :=
  sorry

protected instance subtype.second_countable_topology (α : Type u) [t : topological_space α]
    (s : set α) [second_countable_topology α] : second_countable_topology ↥s :=
  second_countable_topology_induced (↥s) α coe

theorem is_open_generated_countable_inter (α : Type u) [t : topological_space α]
    [second_countable_topology α] :
    ∃ (b : set (set α)), set.countable b ∧ ¬∅ ∈ b ∧ is_topological_basis b :=
  sorry

/- TODO: more fine grained instances for first_countable_topology, separable_space, t2_space, ... -/

protected instance prod.second_countable_topology (α : Type u) [t : topological_space α]
    {β : Type u_1} [topological_space β] [second_countable_topology α]
    [second_countable_topology β] : second_countable_topology (α × β) :=
  second_countable_topology.mk sorry

protected instance second_countable_topology_fintype {ι : Type u_1} {π : ι → Type u_2} [fintype ι]
    [t : (a : ι) → topological_space (π a)] [sc : ∀ (a : ι), second_countable_topology (π a)] :
    second_countable_topology ((a : ι) → π a) :=
  (fun
      (this :
      ∀ (i : ι), ∃ (b : set (set (π i))), set.countable b ∧ ¬∅ ∈ b ∧ is_topological_basis b) =>
      sorry)
    fun (a : ι) => is_open_generated_countable_inter (π a)

protected instance second_countable_topology.to_separable_space (α : Type u)
    [t : topological_space α] [second_countable_topology α] : separable_space α :=
  sorry

theorem is_open_Union_countable {α : Type u} [t : topological_space α] [second_countable_topology α]
    {ι : Type u_1} (s : ι → set α) (H : ∀ (i : ι), is_open (s i)) :
    ∃ (T : set ι),
        set.countable T ∧
          (set.Union fun (i : ι) => set.Union fun (H : i ∈ T) => s i) =
            set.Union fun (i : ι) => s i :=
  sorry

theorem is_open_sUnion_countable {α : Type u} [t : topological_space α]
    [second_countable_topology α] (S : set (set α)) (H : ∀ (s : set α), s ∈ S → is_open s) :
    ∃ (T : set (set α)), set.countable T ∧ T ⊆ S ∧ ⋃₀T = ⋃₀S :=
  sorry

/-- In a topological space with second countable topology, if `f` is a function that sends each
point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
`x ∈ s`, cover the whole space. -/
theorem countable_cover_nhds {α : Type u} [t : topological_space α] [second_countable_topology α]
    {f : α → set α} (hf : ∀ (x : α), f x ∈ nhds x) :
    ∃ (s : set α),
        set.countable s ∧ (set.Union fun (x : α) => set.Union fun (H : x ∈ s) => f x) = set.univ :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.products
! leanprover-community/mathlib commit 024a4231815538ac739f52d08dd20a55da0d6b23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Products
import Mathlib.CategoryTheory.Limits.Preserves.Basic

/-!
# Preserving products

Constructions to relate the notions of preserving products and reflecting products
to concrete fans.

In particular, we show that `piComparison G f` is an isomorphism iff `G` preserves
the limit of `f`.
-/

noncomputable section

universe w v₁ v₂ u₁ u₂

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

variable {C : Type u₁} [Category.{v₁} C]

variable {D : Type u₂} [Category.{v₂} D]

variable (G : C ⥤ D)

namespace CategoryTheory.Limits

variable {J : Type w} (f : J → C)

/-- The map of a fan is a limit iff the fan consisting of the mapped morphisms is a limit. This
essentially lets us commute `Fan.mk` with `Functor.mapCone`.
-/
def isLimitMapConeFanMkEquiv {P : C} (g : ∀ j, P ⟶ f j) :
    IsLimit (Functor.mapCone G (Fan.mk P g)) ≃
      IsLimit (Fan.mk _ fun j => G.map (g j) : Fan fun j => G.obj (f j)) := by
  refine' (IsLimit.postcomposeHomEquiv _ _).symm.trans (IsLimit.equivIsoLimit _)
  refine' Discrete.natIso fun j => Iso.refl (G.obj (f j.as))
  refine' Cones.ext (Iso.refl _) fun j =>
      by dsimp; cases j; simp
#align category_theory.limits.is_limit_map_cone_fan_mk_equiv CategoryTheory.Limits.isLimitMapConeFanMkEquiv

/-- The property of preserving products expressed in terms of fans. -/
def isLimitFanMkObjOfIsLimit [PreservesLimit (Discrete.functor f) G] {P : C} (g : ∀ j, P ⟶ f j)
    (t : IsLimit (Fan.mk _ g)) :
    IsLimit (Fan.mk (G.obj P) fun j => G.map (g j) : Fan fun j => G.obj (f j)) :=
  isLimitMapConeFanMkEquiv _ _ _ (PreservesLimit.preserves t)
#align category_theory.limits.is_limit_fan_mk_obj_of_is_limit CategoryTheory.Limits.isLimitFanMkObjOfIsLimit

/-- The property of reflecting products expressed in terms of fans. -/
def isLimitOfIsLimitFanMkObj [ReflectsLimit (Discrete.functor f) G] {P : C} (g : ∀ j, P ⟶ f j)
    (t : IsLimit (Fan.mk _ fun j => G.map (g j) : Fan fun j => G.obj (f j))) :
    IsLimit (Fan.mk P g) :=
  ReflectsLimit.reflects ((isLimitMapConeFanMkEquiv _ _ _).symm t)
#align category_theory.limits.is_limit_of_is_limit_fan_mk_obj CategoryTheory.Limits.isLimitOfIsLimitFanMkObj

section

variable [HasProduct f]

/--
If `G` preserves products and `C` has them, then the fan constructed of the mapped projection of a
product is a limit.
-/
def isLimitOfHasProductOfPreservesLimit [PreservesLimit (Discrete.functor f) G] :
    IsLimit (Fan.mk _ fun j : J => G.map (Pi.π f j) : Fan fun j => G.obj (f j)) :=
  isLimitFanMkObjOfIsLimit G f _ (productIsProduct _)
#align category_theory.limits.is_limit_of_has_product_of_preserves_limit CategoryTheory.Limits.isLimitOfHasProductOfPreservesLimit

variable [HasProduct fun j : J => G.obj (f j)]

/-- If `pi_comparison G f` is an isomorphism, then `G` preserves the limit of `f`. -/
def PreservesProduct.ofIsoComparison [i : IsIso (piComparison G f)] :
    PreservesLimit (Discrete.functor f) G := by
  apply preservesLimitOfPreservesLimitCone (productIsProduct f)
  apply (isLimitMapConeFanMkEquiv _ _ _).symm _
  refine @IsLimit.ofPointIso _ _ _ _ _ _ _
    (limit.isLimit (Discrete.functor fun j : J => G.obj (f j))) ?_
  apply i
#align category_theory.limits.preserves_product.of_iso_comparison CategoryTheory.Limits.PreservesProduct.ofIsoComparison

variable [PreservesLimit (Discrete.functor f) G]

/--
If `G` preserves limits, we have an isomorphism from the image of a product to the product of the
images.
-/
def PreservesProduct.iso : G.obj (∏ f) ≅ ∏ fun j => G.obj (f j) :=
  IsLimit.conePointUniqueUpToIso (isLimitOfHasProductOfPreservesLimit G f) (limit.isLimit _)
#align category_theory.limits.preserves_product.iso CategoryTheory.Limits.PreservesProduct.iso

@[simp]
theorem PreservesProduct.iso_hom : (PreservesProduct.iso G f).hom = piComparison G f :=
  rfl
#align category_theory.limits.preserves_product.iso_hom CategoryTheory.Limits.PreservesProduct.iso_hom

instance : IsIso (piComparison G f) := by
  rw [← PreservesProduct.iso_hom]
  infer_instance

end

/-- The map of a cofan is a colimit iff the cofan consisting of the mapped morphisms is a colimit.
This essentially lets us commute `Cofan.mk` with `Functor.mapCocone`.
-/
def isColimitMapCoconeCofanMkEquiv {P : C} (g : ∀ j, f j ⟶ P) :
    IsColimit (Functor.mapCocone G (Cofan.mk P g)) ≃
      IsColimit (Cofan.mk _ fun j => G.map (g j) : Cofan fun j => G.obj (f j)) := by
  refine' (IsColimit.precomposeHomEquiv _ _).symm.trans (IsColimit.equivIsoColimit _)
  refine' Discrete.natIso fun j => Iso.refl (G.obj (f j.as))
  refine' Cocones.ext (Iso.refl _) fun j => by dsimp; cases j; simp
#align category_theory.limits.is_colimit_map_cocone_cofan_mk_equiv CategoryTheory.Limits.isColimitMapCoconeCofanMkEquiv

/-- The property of preserving coproducts expressed in terms of cofans. -/
def isColimitCofanMkObjOfIsColimit [PreservesColimit (Discrete.functor f) G] {P : C}
    (g : ∀ j, f j ⟶ P) (t : IsColimit (Cofan.mk _ g)) :
    IsColimit (Cofan.mk (G.obj P) fun j => G.map (g j) : Cofan fun j => G.obj (f j)) :=
  isColimitMapCoconeCofanMkEquiv _ _ _ (PreservesColimit.preserves t)
#align category_theory.limits.is_colimit_cofan_mk_obj_of_is_colimit CategoryTheory.Limits.isColimitCofanMkObjOfIsColimit

/-- The property of reflecting coproducts expressed in terms of cofans. -/
def isColimitOfIsColimitCofanMkObj [ReflectsColimit (Discrete.functor f) G] {P : C}
    (g : ∀ j, f j ⟶ P)
    (t : IsColimit (Cofan.mk _ fun j => G.map (g j) : Cofan fun j => G.obj (f j))) :
    IsColimit (Cofan.mk P g) :=
  ReflectsColimit.reflects ((isColimitMapCoconeCofanMkEquiv _ _ _).symm t)
#align category_theory.limits.is_colimit_of_is_colimit_cofan_mk_obj CategoryTheory.Limits.isColimitOfIsColimitCofanMkObj

section

variable [HasCoproduct f]

/-- If `G` preserves coproducts and `C` has them,
then the cofan constructed of the mapped inclusion of a coproduct is a colimit.
-/
def isColimitOfHasCoproductOfPreservesColimit [PreservesColimit (Discrete.functor f) G] :
    IsColimit (Cofan.mk _ fun j : J => G.map (Sigma.ι f j) : Cofan fun j => G.obj (f j)) :=
  isColimitCofanMkObjOfIsColimit G f _ (coproductIsCoproduct _)
#align category_theory.limits.is_colimit_of_has_coproduct_of_preserves_colimit CategoryTheory.Limits.isColimitOfHasCoproductOfPreservesColimit

variable [HasCoproduct fun j : J => G.obj (f j)]

/-- If `sigma_comparison G f` is an isomorphism, then `G` preserves the colimit of `f`. -/
def PreservesCoproduct.ofIsoComparison [i : IsIso (sigmaComparison G f)] :
    PreservesColimit (Discrete.functor f) G := by
  apply preservesColimitOfPreservesColimitCocone (coproductIsCoproduct f)
  apply (isColimitMapCoconeCofanMkEquiv _ _ _).symm _
  refine @IsColimit.ofPointIso _ _ _ _ _ _ _
    (colimit.isColimit (Discrete.functor fun j : J => G.obj (f j))) ?_
  apply i
#align category_theory.limits.preserves_coproduct.of_iso_comparison CategoryTheory.Limits.PreservesCoproduct.ofIsoComparison

variable [PreservesColimit (Discrete.functor f) G]

/-- If `G` preserves colimits,
we have an isomorphism from the image of a coproduct to the coproduct of the images.
-/
def PreservesCoproduct.iso : G.obj (∐ f) ≅ ∐ fun j => G.obj (f j) :=
  IsColimit.coconePointUniqueUpToIso (isColimitOfHasCoproductOfPreservesColimit G f)
    (colimit.isColimit _)
#align category_theory.limits.preserves_coproduct.iso CategoryTheory.Limits.PreservesCoproduct.iso

@[simp]
theorem PreservesCoproduct.inv_hom : (PreservesCoproduct.iso G f).inv = sigmaComparison G f := rfl
#align category_theory.limits.preserves_coproduct.inv_hom CategoryTheory.Limits.PreservesCoproduct.inv_hom

instance : IsIso (sigmaComparison G f) := by
  rw [← PreservesCoproduct.inv_hom]
  infer_instance

end

end CategoryTheory.Limits


/-
Copyright (c) 2016 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis

Basic properties of matrices and vectors. Proof of Motzkin's transposition theorem.
-/

import data.real data.fin algebra.module
open nat rat

namespace matrix

definition matrix [reducible] (A : Type) (m n : ℕ) := fin m → fin n → A

notation `M_(`m`, `n`)` := matrix _ m n
notation `M[`A`]_(`m`, `n`)` := matrix A m n

-- should rvector and cvector just be notation?

definition rvector [reducible] (A : Type) (n : ℕ) := M[A]_(1, n)

definition cvector [reducible] (A : Type) (m : ℕ) := M[A]_(m, 1)

definition mval {A : Type} (M : matrix A 1 1) : A :=
  M !fin.zero !fin.zero

-- useful for testing
definition cvector_of_list {A : Type} (l : list A) : cvector A (list.length l) :=
  λ i j, list.ith l (fin.val i) !fin.val_lt

definition rvector_of_list {A : Type} (l : list A) : rvector A (list.length l) :=
  λ i j, list.ith l (fin.val j) !fin.val_lt

section matrix_defs

variable {A : Type}
variables {m n k : ℕ}

definition col_of (M : matrix A m n) (j : fin n) : cvector A m := λ a b, M a j

definition row_of (M : matrix A m n) (i : fin m) : rvector A n := λ a b, M i b

definition r_ith (v : rvector A n) (i : fin n) := v !fin.zero i

definition c_ith (v : cvector A m) (i : fin m) := v i !fin.zero

definition nonneg [reducible] [weak_order A] [has_zero A] (M : matrix A m n) := ∀ i j, M i j ≥ 0

definition le [reducible] [has_le A] (M N : matrix A m n) := ∀ i j, M i j ≤ N i j

definition lt [reducible] [has_lt A] (M N : matrix A m n) := ∀ i j, M i j < N i j

definition r_dot [semiring A] (u v : rvector A n) := Suml (fin.upto n) (λ i, r_ith u i * r_ith v i)

definition c_dot [semiring A] (u v : cvector A m) := Suml (fin.upto m) (λ i, c_ith u i * c_ith v i)

definition transpose (M : matrix A m n) : matrix A n m := λ a b, M b a
notation M`^Tr` := transpose M

definition dot [semiring A] (u : rvector A n) (v : cvector A n) := c_dot (u^Tr) v

theorem transpose_transpose (M : matrix A m n) : (M^Tr)^Tr = M := rfl

theorem c_ith_cvector_of_rvector_eq_c_ith (u : rvector A n) (i : fin n) :
        c_ith (transpose u) i = r_ith u i :=
  rfl

theorem r_dot_zero [semiring A] (u : rvector A n) : r_dot u (λ a b, 0) = 0 :=
  begin
    unfold r_dot,
    have H : (λ i, r_ith u i * r_ith (λ (a : fin 1) (b : fin n), 0) i) = (λ i, 0), begin
      apply funext, intro,
      rewrite [↑r_ith, mul_zero]
    end,
    rewrite H,
    apply Suml_zero
  end

theorem r_zero_dot [semiring A] (u : rvector A n) : r_dot (λ a b, 0) u = 0 :=
  begin
    unfold r_dot,
    have H : (λ i, r_ith (λ (a : fin 1) (b : fin n), 0) i * r_ith u i) = (λ i, 0), begin
      apply funext, intro,
      rewrite [↑r_ith, zero_mul]
    end,
    rewrite H,
    apply Suml_zero
  end

theorem c_dot_zero [semiring A] (u : cvector A n) : c_dot u (λ a b, 0) = 0 :=
  begin
    unfold c_dot,
    have H : (λ i, c_ith u i * c_ith (λ (a : fin n) (b : fin 1), 0) i) = (λ i, 0), begin
      apply funext, intro,
      rewrite [↑c_ith, mul_zero]
    end,
    rewrite H,
    apply Suml_zero
  end

theorem c_zero_dot [semiring A] (u : cvector A n) : c_dot (λ a b, 0) u = 0 :=
  begin
    unfold c_dot,
    have H : (λ i, c_ith (λ (a : fin n) (b : fin 1), 0) i * c_ith u i) = (λ i, 0), begin
      apply funext, intro,
      rewrite [↑c_ith, zero_mul]
    end,
    rewrite H,
    apply Suml_zero
  end

theorem dot_zero [semiring A] (u : rvector A n) : dot u (λ a b, 0) = 0 :=
  !c_dot_zero

theorem zero_dot [semiring A] (u : cvector A n) : dot (λ a b, 0) u = 0 :=
  !c_zero_dot

definition mul [semiring A] (M : matrix A m n) (N : matrix A n k) : matrix A m k :=
  λ (a : fin m) (b : fin k), c_dot (transpose (row_of M a)) (col_of N b)

infix `⬝` := mul

theorem dot_eq_mul [semiring A] (u : rvector A n) (v : cvector A n) : dot u v = (u ⬝ v) !fin.zero !fin.zero :=
  rfl

theorem row_of_rvector (v : rvector A n) : row_of v !fin.zero = v :=
  funext (λ x, by rewrite (fin.fin_one_eq_zero x))

theorem col_of_cvector (v : cvector A m) : col_of v !fin.zero = v :=
  begin
    apply funext,
    intro x,
    apply funext,
    intro y,
    unfold col_of,
    rewrite (fin.fin_one_eq_zero y)
  end

theorem row_of_ith (M : matrix A m n) (x : fin m) (y : fin n) : (row_of M x) !fin.zero y = M x y :=
  rfl

theorem col_of_ith (M : matrix A m n) (x : fin m) (y : fin n) : (col_of M y) x !fin.zero = M x y :=
  rfl

/- Suml theorems. These need a better home, but I'm not sure where. -/

variables {B C T : Type} (l : list T)

theorem Suml_assoc [semiring A] (la : list B) (lb : list C) (f : B → C → A) :
        Suml la (λ a, Suml lb (λ b, f a b))
          = Suml lb (λ b, Suml la (λ a, f a b)) :=
  begin
    induction la with h tt ih,
    {induction lb with h' tt' ih',
    {rewrite Suml_nil},
    {rewrite [Suml_nil at *, Suml_cons, -ih', add_zero]}},
    {induction lb with h' tt' ih',
    {rewrite [Suml_cons, *Suml_nil at *, ih, add_zero]},
    {rewrite [Suml_cons, ih, -Suml_add],
    congruence,
    apply funext,
    intro b,
    rewrite Suml_cons}}
  end

theorem mul_Suml [semiring A] (a : A) (f : T → A) :
        a * Suml l f = Suml l (λ k, a * f k) :=
  begin
    induction l with h tt ih,
    rewrite [Suml_nil, mul_zero],
    rewrite [*Suml_cons, left_distrib, ih]
  end

theorem Suml_mul [semiring A] (a : A) (f : T → A) :
         (Suml l f) * a = Suml l (λ k, f k * a) :=
  begin
    induction l with h tt ih,
    rewrite [Suml_nil, zero_mul],
    rewrite [*Suml_cons, right_distrib, ih]
  end

theorem Suml_nonneg_of_nonneg [ordered_semiring A] (f : T → A)
        (H : Π (i : ℕ) (Hi : i < list.length l), f (list.ith l i Hi) ≥ 0) : Suml l f ≥ (0 : A) :=
  begin
    induction l with h tt ih,
    rewrite Suml_nil,
    apply le.refl,
    rewrite Suml_cons,
    have Hh : f h ≥ 0, begin
      note Hl := H 0 !list.length_cons_pos,
      rewrite list.ith_zero at Hl,
      apply Hl
    end,
    have Htt : Suml tt f ≥ 0, begin
      apply ih,
      intro i Hi,
      have Hsucc : succ i < list.length (list.cons h tt),
        by rewrite list.length_cons; apply nat.add_lt_add_right Hi,
      note Ho := H (succ i) Hsucc,
      rewrite list.ith_succ at Ho,
      apply Ho
    end,
    exact add_nonneg Hh Htt
  end

theorem Suml_le_of_le [ordered_semiring A] (f g : T → A) (H : ∀ t : T, f t ≤ g t) :
        Suml l f ≤ Suml l g :=
  begin
    induction l,
    {rewrite *Suml_nil, apply le.refl},
    {rewrite *Suml_cons, apply add_le_add, apply H, assumption}
  end

theorem Suml_lt_of_lt [ordered_semiring A] (Hl : l ≠ list.nil) (f g : T → A)
        (H : ∀ t : T, f t < g t) : Suml l f < Suml l g :=
  begin
    induction l,
    {apply absurd !rfl Hl},
    {rewrite [*Suml_cons],
    apply add_lt_add_of_lt_of_le,
    apply H,
    induction a_1,
    rewrite *Suml_nil,
    apply le.refl,
    apply le_of_lt,
    apply v_0_1,
    contradiction}
  end

theorem eq_of_Suml_eq_Suml_of_le [ordered_ring A] (f g : T → A) (H : ∀ t : T, f t ≤ g t)
       (HSeq : Suml l f = Suml l g) : ∀ t : T, list.mem t l → f t = g t :=
  begin
    induction l,
    intros,
    contradiction,
    intro t Ht,
    rewrite 2 Suml_cons at HSeq,
    have H1 : Suml a_1 f ≥ Suml a_1 g, from calc
      Suml a_1 f = -f a + (f a + Suml a_1 f) : by rewrite neg_add_cancel_left
             ... = (-f a + g a) + Suml a_1 g : by rewrite [HSeq, -add.assoc]
             ... ≥ Suml a_1 g : begin apply le_add_of_nonneg_left, rewrite add.comm, apply sub_nonneg_of_le !H end,
    have H2 : Suml a_1 f ≤ Suml a_1 g, by apply Suml_le_of_le; exact H,
    cases (list.eq_or_mem_of_mem_cons Ht) with Eta Mta,
    note Heq := eq_of_le_of_ge H2 H1,
    rewrite [Heq at HSeq, Eta],
    apply eq_of_add_eq_add_right HSeq,
    apply v_0,
    exact eq_of_le_of_ge H2 H1,
    exact Mta
  end

theorem Suml_le_of_le_strong [ordered_semiring A] (f g : T → A)
        (H : ∀ t : T, list.mem t l → f t ≤ g t) : Suml l f ≤ Suml l g :=
  begin
    induction l,
    {rewrite *Suml_nil, apply le.refl},
    {rewrite *Suml_cons,
    apply add_le_add,
    apply H,
    apply list.mem_cons,
    apply v_0, intros,
    apply H,
    apply list.mem_cons_of_mem,
    assumption}
  end

theorem Suml_mul_Suml_eq_Suml_Suml_mul [semiring A] (l1 : list B) (l2 : list C) (f : B → A) (g : B → C → A) :
        Suml l1 (λ s, f s * Suml l2 (λ t, g s t)) = Suml l1 (λ s, Suml l2 (λ t, f s * g s t)) :=
  begin
    congruence,
    apply funext,
    intro s,
    rewrite mul_Suml
  end

/- ------------------------- -/

theorem m_mul_assoc [semiring A] {o p : ℕ} (M : matrix A m n) (N : matrix A n o) (O : matrix A o p) :
        M ⬝ (N ⬝ O) = (M ⬝ N) ⬝ O :=
  begin
    rewrite ↑mul,
    repeat (apply funext; intro),
    rewrite [↑c_dot, ↑c_ith, ↑row_of, ↑transpose, ↑col_of, Suml_mul_Suml_eq_Suml_Suml_mul, Suml_assoc],
    congruence, apply funext, intro,
    rewrite Suml_mul,
    congruence, apply funext, intro,
    rewrite mul.assoc
  end

/- order, sign theorems -/

theorem transpose_nonneg_of_nonneg [weak_order A] [has_zero A] {u : rvector A n} (Hu : nonneg u) :
        nonneg (transpose u) :=
  λ i j, !Hu

theorem c_dot_nonneg_of_nonneg [ordered_semiring A] (u v : cvector A m) (Hu : nonneg u) (Hv : nonneg v) :
        c_dot u v ≥ 0 :=
  begin
    unfold c_dot,
    apply Suml_nonneg_of_nonneg,
    intros,
    apply mul_nonneg,
    apply Hu,
    apply Hv
  end

theorem dot_nonneg_of_nonneg [ordered_semiring A] (u v : cvector A m) (Hu : nonneg u) (Hv : nonneg v) :
        c_dot u v ≥ 0 :=
  c_dot_nonneg_of_nonneg _ _ Hu Hv

theorem row_of_nonneg_of_nonneg [weak_order A] [has_zero A] {M : matrix A m n} (HM : nonneg M) (i : fin m) :
        nonneg (row_of M i) :=
  λ a b, !HM

theorem col_of_nonneg_of_nonneg [weak_order A] [has_zero A] {M : matrix A m n} (HM : nonneg M) (i : fin n) :
        nonneg (col_of M i) :=
  λ a b, !HM

theorem mul_nonneg_of_nonneg [ordered_semiring A] (M : matrix A m n) (N : matrix A n k)
        (HM : nonneg M) (HN : nonneg N) : nonneg (M ⬝ N) :=
  begin
    intros,
    unfold mul,
    apply c_dot_nonneg_of_nonneg,
    apply transpose_nonneg_of_nonneg,
    apply row_of_nonneg_of_nonneg HM,
    apply col_of_nonneg_of_nonneg HN
  end

theorem dot_le_dot_of_nonneg_of_le [ordered_semiring A] (u : rvector A n) (v1 v2 : cvector A n)
        (Hu : nonneg u) (Hv : ∀ i, c_ith v1 i ≤ c_ith v2 i) : dot u v1 ≤ dot u v2 :=
  begin
    unfold [dot, c_dot, transpose],
    apply Suml_le_of_le,
    intro,
    apply mul_le_mul_of_nonneg_left,
    apply Hv,
    apply Hu
  end

theorem dot_lt_dot_of_nonneg_of_nonzero_of_lt [linear_ordered_ring A]
        (u : rvector A n) (v1 v2 : cvector A n) (Hu : nonneg u) (i : fin n)
        (Hunz : r_ith u i > 0) (Hv : ∀ i, c_ith v1 i < c_ith v2 i) : dot u v1 < dot u v2 :=
  begin
    apply lt_of_not_ge,
    intro Hge,
    have Hle : dot u v1 ≤ dot u v2, begin
      apply dot_le_dot_of_nonneg_of_le,
      apply Hu,
      intro, apply le_of_lt, apply Hv
    end,
    note Heq := eq_of_le_of_ge Hle Hge,
    have Hilt : r_ith u i * c_ith v1 i < r_ith u i * c_ith v2 i, begin
      apply mul_lt_mul_of_pos_left,
      apply Hv,
      apply Hunz
    end,
    have Hmsle : ∀ t, r_ith u t * c_ith v1 t ≤ r_ith u t * c_ith v2 t, begin
      intro,
      apply mul_le_mul_of_nonneg_left,
      apply le_of_lt !Hv,
      apply Hu
    end,
    note Hmeq := eq_of_Suml_eq_Suml_of_le _ _ _ Hmsle Heq i !fin.mem_upto,
    rewrite Hmeq at Hilt,
    exact !not_lt_self Hilt
  end

end matrix_defs

section inst_dec

/- instances -/

variables (A : Type) (m n : ℕ)

theorem matrix_inhabited [instance] [HA : inhabited A] :
        inhabited (M[A]_(succ m, succ n)) :=
  inhabited.rec_on HA (λ a, inhabited.mk (λ s t, a))

open list
definition decidable_quant [instance] (P : fin n → Prop) [∀ k, decidable (P k)] : decidable (∀ k, P k) :=
  if H : all (fin.upto n) P then
    decidable.inl (λ k, of_mem_of_all !fin.mem_upto H)
  else
    decidable.inr (λ Hpk, H (all_of_forall (λ a Ha, Hpk a)))

definition matrix_decidable_eq [instance] [decidable_eq A] : decidable_eq (matrix A m n) :=
  λ M N : matrix A m n,
  if H : ∀ i : fin m, ∀ j : fin n, M i j = N i j then
    decidable.inl (funext (λ i, funext (λ j, H i j)))
  else
    decidable.inr (begin intro Heq, apply H, intros, congruence, exact Heq end)

/- matrix A m n is not a strict order if either m or n is 0. If it would be useful,
   we could prove
    order_pair (matrix A (succ m) n)
   and
    order_pair (matrix A m (succ n)).
-/
definition is_weak_order [instance] [order_pair A] : weak_order (matrix A m n) :=
  begin
    fapply weak_order.mk,
    {exact le},
    {unfold le, intros, apply le.refl},
    {unfold le, intros, apply le.trans !a_1 !a_2},
    {unfold le, intros, repeat (apply funext; intro), apply eq_of_le_of_ge !a_1 !a_2}
  end

end inst_dec

section matrix_arith_m_n

definition m_add {A : Type} [has_add A] {m n : ℕ} (B C : matrix A m n) : matrix A m n :=
  λ x y, B x y + C x y

definition m_neg {A : Type} [has_neg A] {m n : ℕ} (B : matrix  A m n) : matrix A m n :=
  λ x y, -B x y

definition m_smul {A : Type} [has_mul A] {m n : ℕ} (c : A) (B : matrix A m n) : matrix A m n :=
  λ x y, c * B x y

definition m_left_module [instance] [reducible] (A : Type) [ring A] (m n : ℕ) : left_module A (matrix A m n) :=
  begin
    fapply left_module.mk,
    {exact m_smul},
    {exact m_add},
    {intros, unfold m_add, repeat (apply funext; intro), rewrite add.assoc},
    {exact λ a b, 0},
    {intros, unfold m_add, repeat (apply funext; intro), rewrite zero_add},
    {intros, unfold m_add, repeat (apply funext; intro), rewrite add_zero},
    {exact m_neg},
    {intros, rewrite [↑m_neg, ↑m_add], repeat (apply funext; intro), rewrite add.left_inv},
    {intros, unfold m_add, repeat (apply funext; intro), rewrite add.comm},
    {intros, rewrite [↑m_smul, ↑m_add], repeat (apply funext; intro), rewrite left_distrib},
    {intros, rewrite [↑m_smul, ↑m_add], repeat (apply funext; intro), rewrite -right_distrib},
    {intros, unfold m_smul, repeat (apply funext; intro), rewrite mul.assoc},
    {intro, unfold m_smul, repeat (apply funext; intro), rewrite one_mul}
  end

variables {A : Type}

theorem Suml_neg [add_comm_group A] {T : Type} (l : list T) (f : T → A) : -(Suml l f) = Suml l (λ t, - f t) :=
  begin
    apply neg_eq_of_add_eq_zero,
    have H : (λ x, f x + -f x) = (λ x, 0), from funext (λ x, !sub_self),
    rewrite [-Suml_add, H],
    apply Suml_zero
  end

theorem distrib_dot_right [ring A] (n : ℕ) (M N : rvector A n) (x : cvector A n) :
        dot (M + N) x = dot M x + dot N x :=
  begin
    change dot (m_add M N) x = (dot M x) + (dot N x),
    rewrite [↑dot, ↑c_dot, ↑m_add, ↑transpose, ↑c_ith, -Suml_add],
    congruence,
    apply funext, intro,
    rewrite right_distrib
  end

theorem distrib_smul_right [ring A] (m n o : ℕ) (M N : matrix A m n) (x : matrix A n o) :
        (M + N) ⬝ x = M ⬝ x + N ⬝ x :=
  begin
    change (m_add M N) ⬝ x = m_add (M ⬝ x) (N ⬝ x),
    rewrite [↑mul, ↑c_dot, ↑m_add],
    repeat (apply funext; intro),
    rewrite [↑c_ith, ↑row_of, ↑col_of, ↑transpose, -Suml_add],
    congruence,
    apply funext, intro,
    rewrite right_distrib
  end

theorem neg_matrix [ring A] (m n : ℕ) (M : matrix A m n) : -M = (λ a b, -M a b) := rfl

theorem zero_matrix [ring A] (m n : ℕ) : (0 : matrix A m n) = (λ a b, 0) := rfl

theorem matrix_add_app [ring A] (m n : ℕ) (M N : matrix A m n) (a : fin m) (b : fin n) :
        (M + N) a b = M a b + N a b := rfl

theorem neg_smul [ring A] (m n o : ℕ) (M : matrix A m n) (N : matrix A n o) : (-M) ⬝ N = - (M ⬝ N) :=
  begin
    rewrite [↑mul],
    repeat (apply funext; intro),
    unfold [c_dot, row_of, col_of, c_ith, transpose],
    rewrite [2 neg_matrix, Suml_neg],
    congruence,
    apply funext, intro,
    rewrite neg_mul_eq_neg_mul
  end

theorem zero_smul [ring A] (l m n : ℕ) (M : matrix A m n) : (0 : matrix A l m) ⬝ M = 0 :=
  begin
    rewrite [↑mul, 2 zero_matrix],
    repeat (apply funext; intro),
    unfold [c_dot, row_of, col_of, transpose, c_ith],
    have H : (λ i, 0 * M i x_1) = (λ i, 0), from funext (λ i, !zero_mul),
    rewrite H,
    apply Suml_zero
  end

theorem smul_zero [ring A] (l m n : ℕ) (M : matrix A l m) : M ⬝ (0 : matrix A m n) = 0 :=
  begin
    rewrite [↑mul, 2 zero_matrix],
    repeat (apply funext; intro),
    unfold [c_dot, row_of, col_of, transpose, c_ith],
    have H : (λ i, M x i * 0) = (λ i, 0), from funext (λ i, !mul_zero),
    rewrite H,
    apply Suml_zero
  end

theorem le_iff_forall_row [weak_order A] {n : ℕ} (u v : rvector A n) :
        u ≤ v ↔ ∀ i, r_ith u i ≤ r_ith v i :=
  begin
    replace u ≤ v with le u v,
    unfold le,
    apply iff.intro,
    {intros H i, apply H},
    {intros H i j, rewrite fin.fin_one_eq_zero, apply H}
  end

theorem le_iff_forall_col [weak_order A] {n : ℕ} (u v : cvector A n) :
        u ≤ v ↔ ∀ i, c_ith u i ≤ c_ith v i :=
  begin
    replace u ≤ v with le u v,
    unfold le,
    apply iff.intro,
    {intros H i, apply H},
    {intros H i j, rewrite fin.fin_one_eq_zero, apply H}
  end

-- why doesn't rfl work to prove this?
theorem nonneg_iff_le_zero_row [ordered_ring A] {n : ℕ} (u : rvector A n) :
        nonneg u ↔ (0 : rvector A n) ≤ u :=
  begin
    change nonneg u ↔ le (λ a b, 0) u,
    reflexivity
  end

theorem nonneg_iff_le_zero_col [ordered_ring A] {n : ℕ} (u : cvector A n) :
        nonneg u ↔ (0 : cvector A n) ≤ u :=
  begin
    change nonneg u ↔ le (0 : cvector A n) u,
    reflexivity
  end

end matrix_arith_m_n

section motzkin_transposition
variables {A : Type} [linear_ordered_ring A]

/-
  n variables
  a strict ineqs  P : M[A]_(a, n), p : cvector a
  b weak ineqs  Q : M[A]_(b, n), q : cvector b
  c eqs  R : M[A]_(c, n), r : cvector c

  There are various ways to express Hsum equivalently: eg,
    (y ⬝ P) + (z ⬝ Q) + (t ⬝ R) = (0 : rvector A n).
-/
variables {a b c n : ℕ}
        (P : M[A]_(a, n)) (Q : M[A]_(b, n)) (R : M[A]_(c, n))
        (p : cvector A a) (q : cvector A b) (r : cvector A c)
        (y : rvector A a) (z : rvector A b) (t : rvector A c)
        (Hnny : nonneg y) (Hnnz : nonneg z)
        (Hsum : ∀ i : fin n, r_ith (y ⬝ P) i + r_ith (z ⬝ Q) i + r_ith (t ⬝ R) i = 0)

include Hsum

-- .3 seconds to elaborate
private theorem dot_eq_zero {x : cvector A n} (HsatR : ∀ i : fin c, c_ith (R⬝x) i = c_ith r i) :
        dot y (P ⬝ x) + dot z (Q ⬝ x) + dot t r = 0 :=
  begin
    have Hneg : (y ⬝ P) + (z ⬝ Q) + (t ⬝ R) = (0 : rvector A n), begin
      change (λ a b, (y⬝P + z⬝Q + t⬝R) a b) = (λ a b, 0),
      repeat (apply funext; intro),
      rewrite fin.fin_one_eq_zero,
      apply Hsum
    end,
    have Hr : R⬝x = r, begin
      repeat (apply funext; intro),
      rewrite fin.fin_one_eq_zero,
      apply HsatR
    end,
    have Hneg' : ((y ⬝ P) + (z ⬝ Q) + (t ⬝ R)) ⬝ x = 0 ⬝ x, by rewrite Hneg, -- this line and the following take about .1 sec
    rewrite [2 distrib_smul_right at Hneg',  -3 m_mul_assoc at Hneg', Hr at Hneg',
            zero_smul at Hneg', zero_matrix at Hneg'],
    have Hneg'' : (λ a b : fin 1, (y⬝(P⬝x) + z⬝(Q⬝x) + t⬝r) a b) = (λ a b : fin 1, 0), from Hneg',
    have Heqz : (y⬝(P⬝x) + z⬝(Q⬝x) + t⬝r) !fin.zero !fin.zero = 0, by rewrite Hneg'',
    have Heqz' : (y⬝(P⬝x)) !fin.zero !fin.zero + (z⬝(Q⬝x)) !fin.zero !fin.zero + (t⬝r) !fin.zero !fin.zero = 0,
               from Heqz,
    rewrite *dot_eq_mul,
    exact Heqz'
  end

include Hnny Hnnz

theorem motzkin_transposition_with_equalities_lt
        (Hlt : (c_dot (y^Tr) p + c_dot (z^Tr) q + c_dot (t^Tr) r < 0)) :
         ¬ ∃ x : cvector A n, (∀ i, c_ith (P ⬝ x) i < c_ith p i) ∧
                              (∀ i, c_ith (Q ⬝ x) i ≤ c_ith q i) ∧
                              (∀ i, c_ith (R ⬝ x) i = c_ith r i) :=
  begin
    intro Hsat,
    cases Hsat with x Hsat,
    cases Hsat with HsatP Hsat,
    cases Hsat with HsatQ HsatR,
    note Heqz' := dot_eq_zero P Q R r y z t Hsum HsatR,
    apply not_lt_self (0 : A),
    rewrite -Heqz' at {1},
    have Hdlt : dot y (P⬝x) + dot z (Q⬝x) + dot t r ≤ dot y p + dot z q + dot t r, begin
      apply add_le_add_right,
      apply add_le_add,
      apply dot_le_dot_of_nonneg_of_le,
      exact Hnny,
      intro i,
      apply le_of_lt,
      apply HsatP,
      apply dot_le_dot_of_nonneg_of_le,
      exact Hnnz,
      exact HsatQ
    end,
    apply lt_of_le_of_lt,
    exact Hdlt,
    exact Hlt
  end

theorem motzkin_transposition_with_equalities_le
        (Hyp : (∃ i, r_ith y i > 0) ∧ c_dot (y^Tr) p + c_dot (z^Tr) q + c_dot (t^Tr) r ≤ 0) :
         ¬ ∃ x : cvector A n, (∀ i, c_ith (P ⬝ x) i < c_ith p i) ∧
                              (∀ i, c_ith (Q ⬝ x) i ≤ c_ith q i) ∧
                              (∀ i, c_ith (R ⬝ x) i = c_ith r i) :=
  begin
    intro Hsat,
    cases Hsat with x Hsat,
    cases Hsat with HsatP Hsat,
    cases Hsat with HsatQ HsatR,
    note Heqz' := dot_eq_zero P Q R r y z t Hsum HsatR,
    apply not_lt_self (0 : A),
    rewrite -Heqz' at {1},
    cases Hyp with Hj Hor2,
    cases Hj with j Hj,
    have Hdlt : dot y (P⬝x) + dot z (Q⬝x) + dot t r < dot y p + dot z q + dot t r, begin
      apply add_lt_add_right,
      apply add_lt_add_of_lt_of_le,
      apply dot_lt_dot_of_nonneg_of_nonzero_of_lt,
      exact Hnny,
      exact Hj,
      exact HsatP,
      apply dot_le_dot_of_nonneg_of_le,
      exact Hnnz,
      exact HsatQ
    end,
    apply lt_of_lt_of_le,
    exact Hdlt,
    exact Hor2
  end

theorem motzkin_transposition_with_equalities
        (Hor : (c_dot (y^Tr) p + c_dot (z^Tr) q + c_dot (t^Tr) r < 0) ∨
               ((∃ i : fin a, r_ith y i > 0) ∧ c_dot (y^Tr) p + c_dot (z^Tr) q + c_dot (t^Tr) r ≤ 0)) :
         ¬ ∃ x : cvector A n, (∀ i : fin a, c_ith (P ⬝ x) i < c_ith p i) ∧
                              (∀ i : fin b, c_ith (Q ⬝ x) i ≤ c_ith q i) ∧
                              (∀ i : fin c, c_ith (R ⬝ x) i = c_ith r i) :=
  begin
    cases Hor with Hor1 Hor2,
    {apply motzkin_transposition_with_equalities_lt,
    exact Hnny, exact Hnnz, exact Hsum, exact Hor1},
    {apply motzkin_transposition_with_equalities_le,
    exact Hnny, exact Hnnz, exact Hsum, exact Hor2}
  end

end motzkin_transposition

section matrix_arith_square
open fin
definition sq_matrix_id (A : Type) [has_zero A] [has_one A] (m : ℕ) : matrix A m m :=
  λ x y, if x = y then 1 else 0

theorem Suml_map {A B C : Type} [add_monoid C] (l : list A) (f : A → B) (g : B → C) :
        Suml (list.map f l) g = Suml l (λ a, g (f a)) :=
  begin
    induction l,
    rewrite Suml_nil,
    rewrite [list.map_cons, *Suml_cons, v_0]
  end

-- this is annoying!
theorem dot_basis_vec {A : Type} [semiring A] {m : ℕ} (k : fin m) (f : fin m → A) :
        Suml (upto m) (λ j, (f j) * if j = k then 1 else 0) = f k :=
  begin
    induction m,
    apply false.elim (false_of_fin_zero k),
    rewrite [upto_succ, Suml_cons],
    cases decidable.em (maxi = k) with Heq Hneq,
    {rewrite [if_pos Heq, -Heq, mul_one, -add_zero (f maxi) at {2}],
    congruence,
    have H : (λ a_1 : fin a, f (lift_succ a_1) * ite (lift_succ a_1 = maxi) 1 0) = (λ a_1, 0), begin
      apply funext,
      intro b,
      rewrite [if_neg lift_succ_ne_max, mul_zero]
    end,
    rewrite [Suml_map, H, Suml_zero]},
    {rewrite [if_neg Hneq, mul_zero, zero_add, Suml_map],
    note Hlt := lt_max_of_ne_max (ne.symm Hneq),
    have Hfk : f k = f (lift_succ (fin.mk (val k) Hlt)), begin
      induction k with kv Hkv,
      exact rfl
    end,
    rewrite [Hfk, -(v_0 (fin.mk (val k) Hlt) (λ v, f (lift_succ v)))],
    congruence, apply funext, intro j,
    cases decidable.em (lift_succ j = k) with Hjk Hnjk,
    have Hjk' : j = mk (val k) Hlt, begin
      induction j with vj Hvj,
      congruence,
      rewrite -Hjk
    end,
    rewrite [if_pos Hjk, if_pos Hjk'],
    have Hjk' : j ≠ mk (val k) Hlt, begin
      intro Hjk,
      apply Hnjk,
      induction k,
      rewrite Hjk
    end,
    rewrite [if_neg Hnjk, if_neg Hjk']}
  end

theorem b_vec_dot' {A : Type} [semiring A] {m : ℕ} (k : fin m) (f : fin m → A) :
        Suml (upto m) (λ j, (if k = j then 1 else 0) * f j) = f k :=
  begin
    have H : (λ j, (if k = j then 1 else 0) * f j) = (λ j, (f j) * if j = k then 1 else 0), begin
      apply funext, intro,
      cases decidable.em (k = x) with Heq Hneq,
      rewrite [if_pos Heq, if_pos (eq.symm Heq), mul_one, one_mul],
      rewrite [if_neg Hneq, if_neg (ne.symm Hneq), mul_zero, zero_mul]
    end,
    rewrite [H, dot_basis_vec]
  end

theorem sq_matrix_mul_one {A : Type} [semiring A] {m : ℕ} (M : matrix A m m) : mul M (sq_matrix_id A m) = M :=
  begin
    rewrite [↑sq_matrix_id, ↑mul],
    repeat (apply funext; intro),
    rewrite [↑row_of, ↑transpose, ↑col_of, ↑c_dot, ↑c_ith, dot_basis_vec]
  end

theorem sq_matrix_one_mul {A : Type} [semiring A] {m : ℕ} (M : matrix A m m) : mul (sq_matrix_id A m) M = M :=
  begin
    rewrite [↑sq_matrix_id, ↑mul],
    repeat (apply funext; intro),
    rewrite [↑row_of, ↑transpose, ↑col_of, ↑c_dot, ↑c_ith, b_vec_dot']
  end

theorem sq_matrix_left_distrib {A : Type} [semiring A] {m : ℕ} (M N O : matrix A m m) :
         mul M (m_add N O) = m_add (mul M N) (mul M O) :=
  begin
    rewrite [↑mul, ↑m_add],
    repeat (apply funext; intros),
    rewrite [↑c_dot, ↑transpose, ↑row_of, ↑col_of, ↑c_ith, -Suml_add],
    congruence,
    apply funext,
    intro,
    rewrite left_distrib
  end

theorem sq_matrix_right_distrib {A : Type} [semiring A] {m : ℕ} (M N O : matrix A m m) :
         mul (m_add N O) M = m_add (mul N M) (mul O M) :=
  begin
    rewrite [↑mul, ↑m_add],
    repeat (apply funext; intros),
    rewrite [↑c_dot, ↑transpose, ↑row_of, ↑col_of, ↑c_ith, -Suml_add],
    congruence,
    apply funext,
    intro,
    rewrite right_distrib
  end

definition m_square_ring [instance] [reducible] (A : Type) [ring A] (m : ℕ) : ring (matrix A m m) :=
  ⦃ring, m_left_module A m m,
   mul := λ B C, mul B C,
   mul_assoc := λ B C D, eq.symm !m_mul_assoc,
   one := sq_matrix_id A m,
   one_mul := sq_matrix_one_mul,
   mul_one := sq_matrix_mul_one,
   left_distrib := sq_matrix_left_distrib,
   right_distrib := by intros; apply sq_matrix_right_distrib⦄

end matrix_arith_square

/-
section test
open list rat int  -- why aren't rats pretty printing right?
definition c1 : cvector ℕ  _ := cvector_of_list [3, 4, 2]
definition c2 : rvector ℕ _ := rvector_of_list [1, 0, 2]

definition f1 : fin 2 := fin.mk 1 dec_trivial

definition m1 : matrix ℤ 2 2 := λ a b, fin.val a + fin.val b

eval col_of m1 (fin.mk 1 dec_trivial)

definition m2 : matrix ℤ 2 2 := λ a b, fin.val a * fin.val b + 3

definition m10 : matrix ℕ 10 10 := λ a b, fin.val a * fin.val b + 3

definition prd := m1 * m2

definition prd' := (m1 * m2) + 3
eval prd f1 f1
eval (m1 * m2) f1 f1
eval (3 : matrix ℤ 2 2) f1 !fin.zero

example : has_mul (matrix ℤ 2 2) := _
check m1 * m2
eval ((m1 * m2) )

eval c_dot c1 (transpose c2)

example : row_of c2 !fin.zero !fin.zero (fin.mk 1 dec_trivial) = c2 !fin.zero (fin.mk 1 dec_trivial) := rfl

example : row_of c2 !fin.zero = c2 := rfl

eval (c2 ⬝ c1) !fin.zero !fin.zero

--example : m10 * !sq_matrix_id = m10 := dec_trivial

definition poly_sum (x : ℕ) := Suml (upto 10) (λ a, (a + 3) * x)

example (b : ℕ) : Suml [b, b] (λ a, a) = 0 + b + b := rfl

--definition lin_poly (x : ℕ → ℕ) := 0 + 5 * x 0 + 2 * x 1 + 3 * x 2 + 11 * x 3

definition lin_poly (x : ℕ → ℕ) := 0 + 11 * x 3 + 3 * x 2 + 2 * x 1 + 5 * x 0

definition coeff_row : rvector ℕ _ := rvector_of_list [5, 2, 3, 11]

open fin
definition var_row (x : ℕ → ℕ) : rvector ℕ 4 := λ i j, x j

example (x : ℕ → ℕ) : r_dot coeff_row (var_row x) = lin_poly x := rfl

definition xs (x : ℕ) : rvector ℕ 10 := λ a b, x

example (x : ℕ) : r_dot (row_of m10 (fin.mk 1 dec_trivial)) (xs x) = poly_sum x := rfl

definition mep : rvector ℕ 0 := λ a b, 2
definition map : matrix ℕ 0 3 := λ a b, 1

eval (mep ⬝ map) !fin.zero !fin.zero

end test-/

end matrix


inductive Foo : Bool → Type where
  | Z  : Foo false
  | O  : Foo false → Foo true
  | E  : Foo true → Foo false

open Foo

def toNat : {b : Bool} → Foo b → Nat
  | _, Z   => 0
  | _, O n => toNat n + 1
  | _, E n => toNat n + 1

example : toNat (E (O Z)) = 2 :=
  rfl

example : toNat Z = 0 :=
  rfl

example (a : Foo false) : toNat (O a) = toNat a + 1 :=
  rfl

example (a : Foo true) : toNat (E a) = toNat a + 1 :=
  rfl