/-
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

end Mathlib


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.computability.DFA
import Mathlib.PostPort

universes u v l

namespace Mathlib

/-!
# Nondeterministic Finite Automata
This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine
which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular
set by evaluating the string over every possible path.
We show that DFA's are equivalent to NFA's however the construction from NFA to DFA uses an
exponential number of states.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true NFA's.
-/

/-- An NFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states. These are the states that it
  may be sent to. -/
structure NFA (α : Type u) (σ : Type v) where
  step : σ → α → set σ
  start : set σ
  accept : set σ

namespace NFA

protected instance inhabited {α : Type u} {σ : Type v} : Inhabited (NFA α σ) :=
  { default := mk (fun (_x : σ) (_x : α) => ∅) ∅ ∅ }

/-- `M.step_set S a` is the union of `M.step s a` for all `s ∈ S`. -/
def step_set {α : Type u} {σ : Type v} (M : NFA α σ) : set σ → α → set σ :=
  fun (Ss : set σ) (a : α) =>
    do
      let S ← Ss
      step M S a

theorem mem_step_set {α : Type u} {σ : Type v} (M : NFA α σ) (s : σ) (S : set σ) (a : α) :
    s ∈ step_set M S a ↔ ∃ (t : σ), ∃ (H : t ∈ S), s ∈ step M t a :=
  sorry

/-- `M.eval_from S x` computes all possible paths though `M` with input `x` starting at an element
  of `S`. -/
def eval_from {α : Type u} {σ : Type v} (M : NFA α σ) (start : set σ) : List α → set σ :=
  list.foldl (step_set M) start

/-- `M.eval x` computes all possible paths though `M` with input `x` starting at an element of
  `M.start`. -/
def eval {α : Type u} {σ : Type v} (M : NFA α σ) : List α → set σ := eval_from M (start M)

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts {α : Type u} {σ : Type v} (M : NFA α σ) : language α :=
  fun (x : List α) => ∃ (S : σ), ∃ (H : S ∈ accept M), S ∈ eval M x

/-- `M.to_DFA` is an `DFA` constructed from a `NFA` `M` using the subset construction. The
  states is the type of `set`s of `M.state` and the step function is `M.step_set`. -/
def to_DFA {α : Type u} {σ : Type v} (M : NFA α σ) : DFA α (set σ) :=
  DFA.mk (step_set M) (start M) (set_of fun (S : set σ) => ∃ (s : σ), ∃ (H : s ∈ S), s ∈ accept M)

@[simp] theorem to_DFA_correct {α : Type u} {σ : Type v} (M : NFA α σ) :
    DFA.accepts (to_DFA M) = accepts M :=
  sorry

end NFA

namespace DFA

/-- `M.to_NFA` is an `NFA` constructed from a `DFA` `M` by using the same start and accept
  states and a transition function which sends `s` with input `a` to the singleton `M.step s a`. -/
def to_NFA {α : Type u} {σ' : Type v} (M : DFA α σ') : NFA α σ' :=
  NFA.mk (fun (s : σ') (a : α) => singleton (step M s a)) (singleton (start M)) (accept M)

@[simp] theorem to_NFA_eval_from_match {α : Type u} {σ : Type v} (M : DFA α σ) (start : σ)
    (s : List α) : NFA.eval_from (to_NFA M) (singleton start) s = singleton (eval_from M start s) :=
  sorry

@[simp] theorem to_NFA_correct {α : Type u} {σ : Type v} (M : DFA α σ) :
    NFA.accepts (to_NFA M) = accepts M :=
  sorry

end Mathlib


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

Operations on set-valued functions, aka partial multifunctions, aka relations.
-/
import tactic.ext tactic.interactive data.set.lattice order.complete_lattice

variables {α : Type*} {β : Type*} {γ : Type*}

def rel (α : Type*) (β : Type*):= α → β → Prop

namespace rel

variables {δ : Type*} (r : rel α β)

instance : lattice.complete_lattice (rel α β) :=
by unfold rel; apply_instance

def inv : rel β α := flip r

lemma inv_def (x : α) (y : β) : r.inv y x ↔ r x y := iff.rfl

lemma inv_inv : inv (inv r) = r := by { ext x y, reflexivity }

def dom := {x | ∃ y, r x y}

def codom := {y | ∃ x, r x y}

lemma codom_inv : r.inv.codom = r.dom := by { ext x y, reflexivity }

lemma dom_inv : r.inv.dom = r.codom := by { ext x y, reflexivity}

def comp (r : rel α β) (s : rel β γ) : rel α γ :=
λ x z, ∃ y, r x y ∧ s y z

local infixr ` ∘ ` :=rel.comp

lemma comp_assoc (r : rel α β) (s : rel β γ) (t : rel γ δ) :
  (r ∘ s) ∘ t = r ∘ s ∘ t :=
begin
  unfold comp, ext x w, split,
  { rintros ⟨z, ⟨y, rxy, syz⟩, tzw⟩, exact ⟨y, rxy, z, syz, tzw⟩ },
  rintros ⟨y, rxy, z, syz, tzw⟩, exact ⟨z, ⟨y, rxy, syz⟩, tzw⟩
end

@[simp]
lemma comp_right_id (r : rel α β) : r ∘ @eq β = r :=
by { unfold comp, ext y, simp }

@[simp]
lemma comp_left_id (r : rel α β) : @eq α ∘ r = r :=
by { unfold comp, ext x, simp }

lemma inv_id : inv (@eq α) = @eq α :=
by { ext x y, split; apply eq.symm }

lemma inv_comp (r : rel α β) (s : rel β γ) : inv (r ∘ s) = inv s ∘ inv r :=
by { ext x z, simp [comp, inv, flip, and.comm] }

def image (s : set α) : set β := {y | ∃ x ∈ s, r x y}

lemma mem_image (y : β) (s : set α) : y ∈ image r s ↔ ∃ x ∈ s, r x y :=
iff.refl _

lemma image_mono {s t : set α} (h : s ⊆ t) : r.image s ⊆ r.image t :=
assume y ⟨x, xs, rxy⟩, ⟨x, h xs, rxy⟩

lemma image_inter (s t : set α) : r.image (s ∩ t) ⊆ r.image s ∩ r.image t :=
assume y ⟨x, ⟨xs, xt⟩, rxy⟩, ⟨⟨x, xs, rxy⟩, ⟨x, xt, rxy⟩⟩

lemma image_union (s t : set α) : r.image (s ∪ t) = r.image s ∪ r.image t :=
set.subset.antisymm
  (λ y ⟨x, xst, rxy⟩,
    begin
      cases xst with xs xt,
      { left, exact ⟨x, xs, rxy⟩ },
      right, exact ⟨x, xt, rxy⟩
    end)
  (λ y ymem,
    begin
      rcases ymem with ⟨x, xs, rxy⟩ | ⟨x, xt, rxy⟩; existsi x,
      { split, { left, exact xs }, exact rxy},
      split, { right, exact xt }, exact rxy
    end)

@[simp]
lemma image_id (s : set α) : image (@eq α) s = s :=
by { ext x, simp [mem_image] }

lemma image_comp (s : rel β γ) (t : set α) : image (r ∘ s) t = image s (image r t) :=
begin
  ext z, simp only [mem_image, comp], split,
  { rintros ⟨x, xt, y, rxy, syz⟩, exact ⟨y, ⟨x, xt, rxy⟩, syz⟩ },
  rintros ⟨y, ⟨x, xt, rxy⟩, syz⟩, exact ⟨x, xt, y, rxy, syz⟩
end

lemma image_univ : r.image set.univ = r.codom := by { ext y, simp [mem_image, codom] }

def preimage (s : set β) : set α := image (inv r) s

lemma mem_preimage (x : α) (s : set β) : x ∈ preimage r s ↔ ∃ y ∈ s, r x y :=
iff.refl _

lemma preimage_def (s : set β) : preimage r s = {x | ∃ y ∈ s, r x y} :=
set.ext $ λ x, mem_preimage _ _ _

lemma preimage_mono {s t : set β} (h : s ⊆ t) : r.preimage s ⊆ r.preimage t :=
image_mono _ h

lemma preimage_inter (s t : set β) : r.preimage (s ∩ t) ⊆ r.preimage s ∩ r.preimage t :=
image_inter _ s t

lemma preimage_union (s t : set β) : r.preimage (s ∪ t) = r.preimage s ∪ r.preimage t :=
image_union _ s t

lemma preimage_id (s : set α) : preimage (@eq α) s = s :=
by simp only [preimage, inv_id, image_id]

lemma preimage_comp (s : rel β γ) (t : set γ) :
  preimage (r ∘ s) t = preimage r (preimage s t) :=
by simp only [preimage, inv_comp, image_comp]

lemma preimage_univ : r.preimage set.univ = r.dom :=
by { rw [preimage, image_univ, codom_inv] }

def core (s : set β) := {x | ∀ y, r x y → y ∈ s}

lemma mem_core (x : α) (s : set β) : x ∈ core r s ↔ ∀ y, r x y → y ∈ s :=
iff.refl _

lemma core_mono {s t : set β} (h : s ⊆ t) : r.core s ⊆ r.core t :=
assume x h' y rxy, h (h' y rxy)

lemma core_inter (s t : set β) : r.core (s ∩ t) = r.core s ∩ r.core t :=
set.ext (by simp [mem_core, imp_and_distrib, forall_and_distrib])

lemma core_union (s t : set β) : r.core (s ∪ t) ⊇ r.core s ∪ r.core t :=
λ x,
  begin
    simp [mem_core], intro h, cases h with hs ht; intros y rxy,
    { left, exact hs y rxy },
    right, exact ht y rxy
  end

lemma core_univ : r.core set.univ = set.univ := set.ext (by simp [mem_core])

lemma core_id (s : set α): core (@eq α) s = s :=
by simp [core]

lemma core_comp (s : rel β γ) (t : set γ) :
  core (r ∘ s) t = core r (core s t) :=
begin
  ext x, simp [core, comp], split,
  { intros h y rxy z syz, exact h z y rxy syz },
  intros h z y rzy syz, exact h y rzy z syz
end

def restrict_domain (s : set α) : rel {x // x ∈ s} β :=
λ x y, r x.val y

theorem image_subset_iff (s : set α) (t : set β) : image r s ⊆ t ↔ s ⊆ core r t :=
iff.intro
  (λ h x xs y rxy, h ⟨x, xs, rxy⟩)
  (λ h y ⟨x, xs, rxy⟩, h xs y rxy)

theorem core_preimage_gc : galois_connection (image r) (core r) :=
image_subset_iff _

end rel

namespace function

def graph (f : α → β) : rel α β := λ x y, f x = y

end function

namespace set

-- TODO: if image were defined with bounded quantification in corelib, the next two would
-- be definitional

lemma image_eq (f : α → β) (s : set α) : f '' s = (function.graph f).image s :=
by simp [set.image, function.graph, rel.image]

lemma preimage_eq (f : α → β) (s : set β) :
  f ⁻¹' s = (function.graph f).preimage s :=
by simp [set.preimage, function.graph, rel.preimage, rel.inv, flip, rel.image]

lemma preimage_eq_core (f : α → β) (s : set β) :
  f ⁻¹' s = (function.graph f).core s :=
 by simp [set.preimage, function.graph, rel.core]

end set


def f (x : α) := x

theorem ex1 (a : α) (b : List α) : f (a::b = []) = False :=
  by simp [f]

def length : List α → Nat
  | []    => 0
  | a::as => length as + 1

theorem ex2 (a b c : α) (as : List α) : length (a :: b :: as) > length as := by
  simp [length]
  apply Nat.lt.step
  apply Nat.ltSuccSelf

def fact : Nat → Nat
  | 0 => 1
  | x+1 => (x+1) * fact x

theorem ex3 : fact x > 0 := by
  induction x with
  | zero => rfl
  | succ x ih =>
    simp [fact]
    apply Nat.mulPos
    apply Nat.zeroLtSucc
    apply ih

def head [Inhabited α] : List α → α
  | []   => arbitrary
  | a::_ => a

theorem ex4 [Inhabited α] (a : α) (as : List α) : head (a::as) = a :=
  by simp [head]

def foo := 10

theorem ex5 (x : Nat) : foo + x = 10 + x := by
  simp [foo]
  done

def g (x : Nat) : Nat := do
  let x ← pure x
  return x

theorem ex6 : g x = x := by
  simp [g, bind, pure]

def f1 : StateM Nat Unit := do
  modify fun x => g x

def f2 : StateM Nat Unit := do
  let s ← get
  set <| g s

theorem ex7 : f1 = f2 := by
  simp [f1, f2, bind, StateT.bind, get, getThe, MonadStateOf.get, StateT.get, pure, set, StateT.set, modify, modifyGet, MonadStateOf.modifyGet, StateT.modifyGet]

def h (x : Nat) : Sum (Nat × Nat) Nat := Sum.inl (x, x)

def bla (x : Nat) :=
  match h x with
  | Sum.inl (y, z) => y + z
  | Sum.inr _ => 0

theorem ex8 (x : Nat) : bla x = x + x := by
  simp [bla, h]


import linear_algebra.quadratic_form
import analysis.special_functions.pow

/-
Sylvester's law of inertia:
- We would like to prove the complex version first:
  A quadratic form `Q` over the field `R` is isometric to a quadratic form
  in the form
  ` ∑ xᵢ^2 `
The idea is we would like to expand the API for `quadratic_form.equivalent`.
  Given a orthogonal basis wrt. some quadratic form, we should have a equivalent
form. This will be constructed.
-/

open_locale big_operators classical

variables {R : Type*} [ring R]
variables {R₁ : Type*} [comm_ring R₁] [invertible (2 : R₁)]
variables {M : Type*} [add_comm_group M] [module R M] [module R₁ M]
variables {M₁ : Type*} [add_comm_group M₁] [module R M₁]
variables {ι : Type*} [fintype ι] {v : ι → M}

-- Should be a def since it takes a parameter
def field.invertible {K : Type*} [field K] {z : K} (hz : z ≠ 0) : invertible z :=
{ inv_of := z⁻¹,
  inv_of_mul_self := inv_mul_cancel hz,
  mul_inv_of_self := mul_inv_cancel hz }

lemma is_basis.smul_of_invertible {v : ι → M} (hv : is_basis R v)
  {w : ι → R} (hw : ∀ i : ι, invertible (w i)) :
  is_basis R (λ i, w i • v i) :=
begin
  obtain ⟨hw₁', hw₁''⟩ := hv,
  split,
  { rw linear_independent_iff'' at hw₁' ⊢,
    intros s g hgs hsum i,
    have hw₁ : g i * w i = 0 := hw₁' s (λ i, g i • w i) _ _ i,
    { suffices : g i * w i * (hw i).inv_of = 0,
        rwa [mul_assoc, mul_inv_of_self, mul_one] at this,
      rw [hw₁, zero_mul] },
    { intros i hi,
      simp only [algebra.id.smul_eq_mul, hgs i hi, zero_smul] },
    { rw [← hsum, finset.sum_congr rfl _],
      intros, simp only [smul_assoc] } },
  { rw eq_top_iff,
    intros j hj,
    rw ← hw₁'' at hj,
    rw submodule.mem_span at hj ⊢,
    refine λ p hp, hj p (λ u hu, _),
    obtain ⟨i, rfl⟩ := hu,
    have := p.smul_mem (⅟ (w i)) (hp ⟨i, rfl⟩),
    simp only [← smul_assoc, smul_eq_mul, inv_of_mul_self, one_smul] at this,
    exact this }
end

namespace quadratic_form

open finset bilin_form

/-- A quadratic form composed with a `linear_equiv` is isometric to itself. -/
def isometry_of_comp_linear_equiv (Q : quadratic_form R M) (f : M₁ ≃ₗ[R] M) :
  Q.isometry (Q.comp (f : M₁ →ₗ[R] M)) :=
{ map_app' :=
  begin
    intro,
    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.to_fun_eq_coe,
               linear_equiv.apply_symm_apply, f.apply_symm_apply],
  end, .. f.symm }

/-- Given a quadratic form `Q` and a basis, `of_is_basis` is the basis representation of `Q`. -/
noncomputable def of_is_basis (Q : quadratic_form R M)
  (hv₁ : is_basis R v) : quadratic_form R (ι → R) := Q.comp hv₁.equiv_fun.symm

@[simp]
lemma isometry_of_is_basis_apply (Q : quadratic_form R M) (hv₁ : is_basis R v)
  (w : ι → R) : Q.of_is_basis hv₁ w = Q (∑ i : ι, w i • v i) :=
by { rw ← hv₁.equiv_fun_symm_apply, refl }

/-- A quadratic form is isometric to its bases representations. -/
noncomputable def isometry_of_is_basis (Q : quadratic_form R M) (hv₁ : is_basis R v) :
  isometry Q (Q.of_is_basis hv₁) :=
isometry_of_comp_linear_equiv Q hv₁.equiv_fun.symm

lemma isometry_of_is_Ortho_apply [invertible (2 : R₁)]
  (Q : quadratic_form R₁ M) (hv₁ : is_basis R₁ v)
  (hv₂ : (associated Q).is_Ortho v) (w : ι → R₁) :
  Q.of_is_basis hv₁ w = ∑ i : ι, associated Q (v i) (v i) * w i * w i :=
begin
  rw [isometry_of_is_basis_apply, ← @associated_eq_self_apply R₁, sum_left],
  refine sum_congr rfl (λ j hj, _),
  rw [sum_right, sum_eq_single j],
  { rw [smul_left, smul_right], ring },
  { intros i _ hij,
    rw [smul_left, smul_right,
        show (associated_hom R₁) Q (v j) (v i) = 0, by exact hv₂ i j hij,
        mul_zero, mul_zero] },
  { contradiction }
end

/-- The weighted sum of squares with respect some weight as a quadratic form. -/
def weighted_sum_squares (w : ι → R₁) : quadratic_form R₁ (ι → R₁) :=
∑ i : ι, w i • proj i i

@[simp]
lemma weighted_sum_squares_apply (w v : ι → R₁) :
  weighted_sum_squares w v = ∑ i : ι, w i * (v i * v i) :=
quadratic_form.sum_apply _ _ _

variables {V : Type*} {K : Type*} [field K] [invertible (2 : K)]
variables [add_comm_group V] [module K V] [finite_dimensional K V]

lemma equivalent_weighted_sum_squares_of_nondegenerate'
  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank K V) → K,
  (∀ i, w i ≠ 0) ∧ equivalent Q (weighted_sum_squares w) :=
begin
  obtain ⟨v, hv₁, hv₂, hv₃⟩ := exists_orthogonal_basis' hQ associated_is_sym,
  refine ⟨λ i, associated Q (v i) (v i), hv₃, _⟩,
  refine nonempty.intro _,
  convert Q.isometry_of_is_basis hv₂,
  ext w,
  rw [isometry_of_is_Ortho_apply Q hv₂ hv₁, weighted_sum_squares_apply],
  refine finset.sum_congr rfl _,
  intros, rw ← mul_assoc,
end

lemma equivalent_weighted_sum_squares_of_nondegenerate
  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank K V) → K,
    equivalent Q (weighted_sum_squares w) :=
let ⟨w, _, hw₂⟩ := Q.equivalent_weighted_sum_squares_of_nondegenerate' hQ in ⟨w, hw₂⟩

section complex

/-- The isometry between a weighted sum of squares on the complex numbers and the
sum of squares, i.e. `weighted_sum_squares` with weight `λ i : ι, 1`. -/
noncomputable def isometry_sum_squares [decidable_eq ι] (w : ι → ℂ) (hw : ∀ i : ι, w i ≠ 0) :
  isometry (weighted_sum_squares w) (weighted_sum_squares (λ _, 1 : ι → ℂ)) :=
begin
  have hw' : ∀ i : ι, (w i) ^ - (1 / 2 : ℂ) ≠ 0,
  { intros i hi,
    exact hw i ((complex.cpow_eq_zero_iff _ _).1 hi).1 },
  convert (weighted_sum_squares w).isometry_of_is_basis
    (is_basis.smul_of_invertible (pi.is_basis_fun ℂ ι) (λ i, field.invertible (hw' i))),
  ext1 v,
  rw [isometry_of_is_basis_apply, weighted_sum_squares_apply, weighted_sum_squares_apply],
  refine sum_congr rfl (λ j hj, _),
  have hsum : (∑ (i : ι), v i • w i ^ - (1 / 2 : ℂ) •
    (linear_map.std_basis ℂ (λ (i : ι), ℂ) i) 1) j =
    v j • w j ^ - (1 / 2 : ℂ),
  { rw [finset.sum_apply, sum_eq_single j, linear_map.std_basis_apply, pi.smul_apply,
        pi.smul_apply, function.update_same, smul_eq_mul, smul_eq_mul, smul_eq_mul, mul_one],
    intros i _ hij,
    rw [linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply, function.update_noteq hij.symm,
        pi.zero_apply, smul_eq_mul, smul_eq_mul, mul_zero, mul_zero],
    intro hj', exact false.elim (hj' hj) },
  rw [hsum, smul_eq_mul],
  suffices : 1 * v j * v j =  w j ^ - (1 / 2 : ℂ) * w j ^ - (1 / 2 : ℂ) * w j * v j * v j,
  { rw [← mul_assoc, this], ring },
  rw [← complex.cpow_add _ _ (hw j), show - (1 / 2 : ℂ) + - (1 / 2) = -1, by ring,
      complex.cpow_neg_one, inv_mul_cancel (hw j)],
end .

/-- A nondegenerate quadratic form on the complex numbers is equivalent to
the sum of squares, i.e. `weighted_sum_squares` with weight `λ i : ι, 1`. -/
theorem equivalent_sum_squares {M : Type*} [add_comm_group M] [module ℂ M]
  [finite_dimensional ℂ M] (Q : quadratic_form ℂ M) (hQ : (associated Q).nondegenerate) :
  equivalent Q (weighted_sum_squares (λ _, 1 : fin (finite_dimensional.finrank ℂ M) → ℂ)) :=
let ⟨w, hw₁, hw₂⟩ := Q.equivalent_weighted_sum_squares_of_nondegenerate' hQ in
  nonempty.intro $ (classical.choice hw₂).trans (isometry_sum_squares w hw₁)

end complex

section real

/-- The sign function that maps negative real numbers to -1 and nonnegative numbers to 1. -/
noncomputable def sign (r : ℝ) : ℝ := if r < 0 then -1 else 1

lemma sign_apply_eq (r : ℝ) : sign r = -1 ∨ sign r = 1 :=
begin
  by_cases r < 0,
  { exact or.intro_left _ (if_pos h) },
  { exact or.intro_right _ (if_neg h) }
end

lemma sign_mul_nonneg (r : ℝ) : 0 ≤ sign r * r :=
begin
  by_cases r < 0,
  { rw [sign, if_pos h],
    exact mul_nonneg_of_nonpos_of_nonpos (by norm_num) (le_of_lt h) },
  { rw [sign, if_neg h, one_mul],
    exact not_lt.1 h }
end

lemma sign_mul_ne_zero_pos (r : ℝ) (hr : r ≠ 0) : 0 < sign r * r :=
begin
  refine lt_of_le_of_ne (sign_mul_nonneg r) (λ h, _),
  rw zero_eq_mul at h,
  cases sign_apply_eq r with hneg hpos;
  cases h; { linarith <|> exact hr h }
end

lemma sign_inv_eq_self (r : ℝ) : (sign r)⁻¹ = sign r :=
begin
  cases sign_apply_eq r with h h,
  { rw h, norm_num },
  { rw h, exact inv_one }
end

/-- The isometry between a weighted sum of squares with weights `u` on the complex numbers
and the weighted sum of squares with weights `sign ∘ u`. -/
noncomputable def isometry_sign_weighted_sum_squares'
  [decidable_eq ι] (u : ι → ℝ) (hu : ∀ i : ι, u i ≠ 0) :
  isometry (weighted_sum_squares u) (weighted_sum_squares (sign ∘ u)) :=
begin
  have hu' : ∀ i : ι, 0 ≠ (sign (u i) * u i) ^ - (1 / 2 : ℝ),
  { intro i, exact ne_of_lt (real.rpow_pos_of_pos (sign_mul_ne_zero_pos _ (hu i)) _) },
  convert ((weighted_sum_squares u).isometry_of_is_basis
    (is_basis.smul_of_invertible (pi.is_basis_fun ℝ ι) (λ i, field.invertible (hu' i).symm))),
  ext1 v,
  rw [isometry_of_is_basis_apply, weighted_sum_squares_apply, weighted_sum_squares_apply],
  refine sum_congr rfl (λ j hj, _),
  have hsum : (∑ (i : ι), v i • (sign (u i) * u i) ^ - (1 / 2 : ℝ) •
    (linear_map.std_basis ℝ (λ (i : ι), ℝ) i) 1) j =
    v j • (sign (u j) * u j) ^ - (1 / 2 : ℝ),
  { rw [finset.sum_apply, sum_eq_single j, linear_map.std_basis_apply, pi.smul_apply,
        pi.smul_apply, function.update_same, smul_eq_mul, smul_eq_mul, smul_eq_mul, mul_one],
    intros i _ hij,
    rw [linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply, function.update_noteq hij.symm,
        pi.zero_apply, smul_eq_mul, smul_eq_mul, mul_zero, mul_zero],
    intro hj', exact false.elim (hj' hj) },
  rw [hsum, smul_eq_mul],
  suffices : (sign ∘ u) j * v j * v j = (sign (u j) * u j) ^ - (1 / 2 : ℝ) *
    (sign (u j) * u j) ^ - (1 / 2 : ℝ) * u j * v j * v j,
  { rw [← mul_assoc, this], ring },
  rw [← real.rpow_add (sign_mul_ne_zero_pos _ (hu j)),
      show - (1 / 2 : ℝ) + - (1 / 2) = -1, by ring, real.rpow_neg_one, mul_inv',
      sign_inv_eq_self, mul_assoc (sign (u j)) (u j)⁻¹, inv_mul_cancel (hu j), mul_one],
end

/-- Sylvester's law of inertia: A nondegenerate real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1. -/
theorem equivalent_one_neg_one_weighted_sum_squared
  {M : Type*} [add_comm_group M] [module ℝ M] [finite_dimensional ℝ M]
  (Q : quadratic_form ℝ M) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank ℝ M) → ℝ,
  (∀ i, w i = -1 ∨ w i = 1) ∧ equivalent Q (weighted_sum_squares w) :=
let ⟨w, hw₁, hw₂⟩ := Q.equivalent_weighted_sum_squares_of_nondegenerate' hQ in
  ⟨sign ∘ w, λ i, sign_apply_eq (w i),
    hw₂.trans (nonempty.intro $ isometry_sign_weighted_sum_squares' w hw₁)⟩

end real

-- The idea now is to restrict a degenerate quadratic form onto a smaller subspace
-- such that it becomes nondegenerate.

-- def restrict_nezero (Q : quadratic_form R₁ M) : submodule R₁ M :=
-- { carrier := { v : M | v ≠ 0 → Q v ≠ 0 },
--   zero_mem' := by contradiction,
--   add_mem' :=
--     begin
--       intros x y hx hy hxy,
--       rw [← @associated_eq_self_apply R₁ _ _ _ _ _ _ _ _ _ (x + y),
--           add_left, add_right, add_right],
--       swap, apply_instance, swap, apply_instance,
--       by_cases h₁ : x = 0; by_cases h₂ : y = 0,
--       { exact false.elim (hxy (h₁.symm ▸ h₂.symm ▸ zero_add _)) },
--       { subst h₁, simp only [zero_left, zero_right, zero_add],
--         rw associated_eq_self_apply, exact hy h₂ },
--       {

--       }

--     end,
--   smul_mem' := _ }

end quadratic_form


/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import tactic.by_contra
import data.set.basic

/-!
# Well-founded relations

A relation is well-founded if it can be used for induction: for each `x`, `(∀ y, r y x → P y) → P x`
implies `P x`. Well-founded relations can be used for induction and recursion, including
construction of fixed points in the space of dependent functions `Π x : α , β x`.

The predicate `well_founded` is defined in the core library. In this file we prove some extra lemmas
and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`.
-/

variables {α : Type*}

namespace well_founded
/-- If `r` is a well-founded relation, then any nonempty set has a minimal element
with respect to `r`. -/
theorem has_min {α} {r : α → α → Prop} (H : well_founded r)
  (s : set α) : s.nonempty → ∃ a ∈ s, ∀ x ∈ s, ¬ r x a
| ⟨a, ha⟩ := (acc.rec_on (H.apply a) $ λ x _ IH, not_imp_not.1 $ λ hne hx, hne $
  ⟨x, hx, λ y hy hyx, hne $ IH y hyx hy⟩) ha

/-- A minimal element of a nonempty set in a well-founded order -/
noncomputable def min {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : α :=
classical.some (H.has_min p h)

theorem min_mem {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : H.min p h ∈ p :=
let ⟨h, _⟩ := classical.some_spec (H.has_min p h) in h

theorem not_lt_min {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) {x} (xp : x ∈ p) : ¬ r x (H.min p h) :=
let ⟨_, h'⟩ := classical.some_spec (H.has_min p h) in h' _ xp

theorem well_founded_iff_has_min  {α} {r : α → α → Prop} : (well_founded r) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, ¬ r x m :=
begin
  classical,
  split,
  { exact has_min, },
  { set counterexamples := { x : α | ¬ acc r x},
    intro exists_max,
    fconstructor,
    intro x,
    by_contra hx,
    obtain ⟨m, m_mem, hm⟩ := exists_max counterexamples ⟨x, hx⟩,
    refine m_mem (acc.intro _ ( λ y y_gt_m, _)),
    by_contra hy,
    exact hm y hy y_gt_m, },
end

lemma eq_iff_not_lt_of_le {α} [partial_order α] {x y : α} : x ≤ y → y = x ↔ ¬ x < y :=
begin
  split,
  { intros xle nge,
    cases le_not_le_of_lt nge,
    rw xle left at nge,
    exact lt_irrefl x nge },
  { intros ngt xle,
    contrapose! ngt,
    exact lt_of_le_of_ne xle (ne.symm ngt) }
end

theorem well_founded_iff_has_max' [partial_order α] : (well_founded ((>) : α → α → Prop) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, m ≤ x → x = m) :=
by simp only [eq_iff_not_lt_of_le, well_founded_iff_has_min]

theorem well_founded_iff_has_min' [partial_order α] : (well_founded (has_lt.lt : α → α → Prop)) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, x ≤ m → x = m :=
@well_founded_iff_has_max' (order_dual α) _

open set
/-- The supremum of a bounded, well-founded order -/
protected noncomputable def sup {α} {r : α → α → Prop} (wf : well_founded r) (s : set α)
  (h : bounded r s) : α :=
wf.min { x | ∀a ∈ s, r a x } h

protected lemma lt_sup {α} {r : α → α → Prop} (wf : well_founded r) {s : set α} (h : bounded r s)
  {x} (hx : x ∈ s) : r x (wf.sup s h) :=
min_mem wf { x | ∀a ∈ s, r a x } h x hx

section
open_locale classical
/-- A successor of an element `x` in a well-founded order is a minimal element `y` such that
`x < y` if one exists. Otherwise it is `x` itself. -/
protected noncomputable def succ {α} {r : α → α → Prop} (wf : well_founded r) (x : α) : α :=
if h : ∃y, r x y then wf.min { y | r x y } h else x

protected lemma lt_succ {α} {r : α → α → Prop} (wf : well_founded r) {x : α} (h : ∃y, r x y) :
  r x (wf.succ x) :=
by { rw [well_founded.succ, dif_pos h], apply min_mem }
end

protected lemma lt_succ_iff {α} {r : α → α → Prop} [wo : is_well_order α r] {x : α} (h : ∃y, r x y)
  (y : α) : r y (wo.wf.succ x) ↔ r y x ∨ y = x :=
begin
  split,
  { intro h', have : ¬r x y,
    { intro hy, rw [well_founded.succ, dif_pos] at h',
      exact wo.wf.not_lt_min _ h hy h' },
    rcases trichotomous_of r x y with hy | hy | hy,
    exfalso, exact this hy,
    right, exact hy.symm,
    left, exact hy },
  rintro (hy | rfl), exact trans hy (wo.wf.lt_succ h), exact wo.wf.lt_succ h
end

end well_founded

namespace function

variables {β : Type*} (f : α → β)

section has_lt

variables [has_lt β] (h : well_founded ((<) : β → β → Prop))

/-- Given a function `f : α → β` where `β` carries a well-founded `<`, this is an element of `α`
whose image under `f` is minimal in the sense of `function.not_lt_argmin`. -/
noncomputable def argmin [nonempty α] : α :=
well_founded.min (inv_image.wf f h) set.univ set.univ_nonempty

lemma not_lt_argmin [nonempty α] (a : α) : ¬ f a < f (argmin f h) :=
well_founded.not_lt_min (inv_image.wf f h) _ _ (set.mem_univ a)

/-- Given a function `f : α → β` where `β` carries a well-founded `<`, and a non-empty subset `s`
of `α`, this is an element of `s` whose image under `f` is minimal in the sense of
`function.not_lt_argmin_on`. -/
noncomputable def argmin_on (s : set α) (hs : s.nonempty) : α :=
well_founded.min (inv_image.wf f h) s hs

@[simp] lemma argmin_on_mem (s : set α) (hs : s.nonempty) :
  argmin_on f h s hs ∈ s :=
well_founded.min_mem _ _ _

@[simp] lemma not_lt_argmin_on (s : set α) {a : α} (ha : a ∈ s)
  (hs : s.nonempty := set.nonempty_of_mem ha) :
  ¬ f a < f (argmin_on f h s hs) :=
well_founded.not_lt_min (inv_image.wf f h) s hs ha

end has_lt

section linear_order

variables [linear_order β] (h : well_founded ((<) : β → β → Prop))

@[simp] lemma argmin_le (a : α) [nonempty α] : f (argmin f h) ≤ f a :=
not_lt.mp $ not_lt_argmin f h a

@[simp] lemma argmin_on_le (s : set α) {a : α} (ha : a ∈ s)
  (hs : s.nonempty := set.nonempty_of_mem ha) : f (argmin_on f h s hs) ≤ f a :=
not_lt.mp $ not_lt_argmin_on f h s ha hs

include h
theorem well_founded.self_le_of_strict_mono {φ : β → β} (hφ : strict_mono φ) : ∀ n, n ≤ φ n :=
begin
  by_contra' h',
  exact h.not_lt_min _ h' (@hφ _ (h.min _ h') (h.min_mem _ h')) (h.min_mem _ h')
end

end linear_order

end function


import binary_nat
import data.nat.pow
import tactic.linarith

open costed_binary_nat
open complexity

universe u
variables {α : Type u}

theorem zero_cost : Π (n), cost.cost_of (zero n) = n + 1
| 0 := by simp [zero, bit_zero]
| (n+1) := begin
  simp [zero, intro, zero_cost],
  ring,
end

theorem add_with_carry_cost : Π {n}, ∀ {x y : binary_nat n} {z : binary_nat 0},
  cost.cost_of (add_with_carry x y z) = 8 * 2^n - 3
| 0 := begin
  intros x y z,
  cases x,
  all_goals {cases y},
  all_goals {cases z},
  all_goals {simp [add_with_carry]},
end
| (n+1) := begin
  intros x y z,
  cases x with _ xu xl,
  cases y with _ yu yl,
  simp [add_with_carry, add_with_carry_cost, pow_succ],
  ring_nf,
  have g := nat.one_le_two_pow n,
  simp [@nat.succ_mul 1, nat.add_assoc],
  rw [nat.sub_add_cancel, ← nat.sub_add_comm],
  ring_nf,
  all_goals {linarith},
end

theorem add_cost {n : ℕ} : ∀ {x y : binary_nat n},
  cost.cost_of (add x y) = 8 * 2^n - 2 :=
begin
  intros x y,
  simp [add, add_with_carry_cost],
  rw ← nat.sub_add_comm,
  simp,
  have g := nat.one_le_two_pow n,
  apply le_mul_of_le_of_one_le,
  simp,
  apply nat.one_le_two_pow,
end

lemma tmul_dvd3 : ∀ n : ℕ, 3 ∣ 2 * 4 ^ n - 2
| 0 := by simp[pow_zero]
| (n+1) := begin
  rw [pow_succ,
      (show 4*4^n = (1+3)*4^n, by simp),
      add_mul, mul_add, one_mul, mul_left_comm,
      nat.sub_add_comm],
  apply dvd_add,
  apply tmul_dvd3,
  apply dvd_mul_right,
  have t : 1 ≤ 4 ^ n := nat.one_le_pow _ _ (by simp),
  linarith,
end

lemma tmul_dvd3' : (∀ n : ℕ, 3 ∣ 8 * 4 ^ n - 2) :=
begin
  intro n,
  rw [(show 8 = (2+3*2), by ring), add_mul, nat.sub_add_comm],
  apply dvd_add,
  apply tmul_dvd3,
  rw [mul_assoc],
  apply dvd_mul_right,
  have t : 1 ≤ 4 ^ n := nat.one_le_pow _ _ (by simp),
  linarith,
end

lemma tmul_lt :  (∀ n : ℕ, n ≤ 2^n ∧ 2^n ≤ 4^n)
| 0 := by simp
| (n+1) := begin
  split,
  rw [pow_succ, nat.succ_mul, nat.one_mul],
  apply add_le_add (tmul_lt n).left,
  apply nat.one_le_pow,
  simp,
  rw [pow_succ, pow_succ],
  apply mul_le_mul _ (tmul_lt n).right,
  simp,
  simp,
  simp,
end

lemma tmul_lt' : (∀ {n c d : ℕ}, c ≤ 20 → 4 * n + (192 * 2 ^ n + c) ≤ 224 * 4 ^ n + d) :=
begin
  intros n c d p,
  apply le_add_right,
  rw [show 224 = 4 + (192 + 28), by simp, add_mul, add_mul],
  apply add_le_add,
  apply nat.mul_le_mul (le_refl _) (le_trans (tmul_lt _).left (tmul_lt _).right),
  apply add_le_add,
  apply nat.mul_le_mul (le_refl _) (tmul_lt _).right,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  linarith,
end

lemma tmul_lt'' : (∀ {n c d : ℕ}, c ≤ 5 → n + (48 * 2 ^ (n + 1) + c) ≤ 56 * 4 ^ (n + 1) + d) :=
begin
  intros n c d p,
  apply le_add_right,
  rw [show 56 = 1 + (48 + 7), by simp, add_mul, add_mul, one_mul],
  apply add_le_add,
  rw [← @nat.add_le_add_iff_right 1],
  apply le_add_right,
  apply le_trans (tmul_lt _).left (tmul_lt _).right,
  apply add_le_add,
  apply nat.mul_le_mul (le_refl _) (tmul_lt _).right,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  linarith,
end

-- f(n+1) = 4*f(n) + 24 * 2 ^(n+2) + 3*n + 10
-- f(0) = 5
theorem traditional_multiply_cost : Π {n}, ∀ {x y : binary_nat n},
    cost.cost_of (traditional_multiply x y) = 56 * 4^n + (2*4^n-2)/3 - (48*2^n + n + 3)
| 0 := begin
  intros x y,
  cases x,
  all_goals {cases y},
  all_goals {simp[traditional_multiply]},
  all_goals {ring},
end
| (n+1) := begin
  have g : (∀ {a b c : ℕ}, a ≤ b → (b - a = c ↔ b = c + a)),
  { intros a b c p,
    split,
    intro q,
    rw[← q, nat.sub_add_cancel p],
    intro q,
    rw[q, nat.add_sub_cancel],
  },
  have g' : (∀ {a b c : ℕ}, a ≤ b → (c = b - a ↔ c + a = b)),
  {
    intros a b c p,
    split,
    intro q,
    apply eq.symm,
    rw [← g p],
    exact eq.symm q,
    intro q,
    apply eq.symm,
    rw [g p],
    exact eq.symm q,
  },
  intros x y,
  cases x with _ xu xl,
  cases y with _ yu yl,
  simp[traditional_multiply, zero_cost, add_cost],
  cases (cost.value_of (traditional_multiply xu yl)) with _ ulu ull,
  cases (cost.value_of (traditional_multiply xl yu)) with _ luu lul,
  simp [split, traditional_multiply_cost, nat.add_assoc],
  ring_nf,
  rw [g'],
  simp [nat.mul_sub_left_distrib],
  rw [@nat.add_comm (3*n)],
  repeat { rw [← nat.sub_add_comm] },
  rw [g],
  rw [@nat.add_comm (3 * (8 * 2 ^ (n + 2)))],
  repeat { rw [← nat.sub_add_comm] },
  rw [g],
  simp [pow_succ, mul_add, nat.add_assoc],
  ring_nf,
  rw [add_left_cancel_iff,
      nat.add_left_comm, add_left_cancel_iff,
      nat.add_left_comm, add_left_cancel_iff],
  rw [show 20 = 2 + 18, by simp],
  simp[← nat.add_assoc],
  apply nat.eq_of_mul_eq_mul_left (show 0 < 3, by simp),
  rw [nat.mul_div_cancel', mul_add, mul_left_comm, nat.mul_div_cancel'],
  simp [nat.mul_sub_left_distrib],
  rw [← nat.sub_add_comm],
  ring_nf,
  have t : 1 ≤ 4 ^ n := nat.one_le_pow _ _ (by simp),
  linarith,
  apply tmul_dvd3,
  apply tmul_dvd3',
  ring_nf,
  rw [nat.add_left_comm _ (224*4^n)],
  apply tmul_lt',
  simp,
  ring_nf,
  rw [nat.add_left_comm _ (224*4^n)],
  apply tmul_lt',
  simp,
  ring_nf,
  apply tmul_lt',
  simp,
  ring_nf,
  apply tmul_lt',
  simp,
  ring_nf,
  apply le_add_right,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  simp,
  ring_nf,
  apply tmul_lt',
  simp,
  ring_nf,
  apply le_add_right,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  simp,
  ring_nf,
  apply tmul_lt',
  simp,
  ring_nf,
  apply le_add_right,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  simp,
  ring_nf,
  apply tmul_lt',
  simp,
  ring_nf,
  rw [mul_comm],
  apply le_mul_of_one_le_of_le,
  apply nat.one_le_pow,
  simp,
  simp,
  apply tmul_lt'',
  simp,
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.matrix.basic
import data.pequiv

/-!
# partial equivalences for matrices

Using partial equivalences to represent matrices.
This file introduces the function `pequiv.to_matrix`, which returns a matrix containing ones and
zeros. For any partial equivalence `f`, `f.to_matrix i j = 1 ↔ f i = some j`.

The following important properties of this function are proved
`to_matrix_trans : (f.trans g).to_matrix = f.to_matrix ⬝ g.to_matrix`
`to_matrix_symm  : f.symm.to_matrix = f.to_matrixᵀ`
`to_matrix_refl : (pequiv.refl n).to_matrix = 1`
`to_matrix_bot : ⊥.to_matrix = 0`

This theory gives the matrix representation of projection linear maps, and their right inverses.
For example, the matrix `(single (0 : fin 1) (i : fin n)).to_matrix` corresponds to the ith
projection map from R^n to R.

Any injective function `fin m → fin n` gives rise to a `pequiv`, whose matrix is the projection
map from R^m → R^n represented by the same function. The transpose of this matrix is the right
inverse of this map, sending anything not in the image to zero.

## notations

This file uses the notation ` ⬝ ` for `matrix.mul` and `ᵀ` for `matrix.transpose`.
-/

namespace pequiv
open matrix

universes u v

variables {k l m n : Type*}
variables {α : Type v}

open_locale matrix

/-- `to_matrix` returns a matrix containing ones and zeros. `f.to_matrix i j` is `1` if
  `f i = some j` and `0` otherwise -/
def to_matrix [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) : matrix m n α :=
of $ λ i j, if j ∈ f i then (1 : α) else 0

-- TODO: set as an equation lemma for `to_matrix`, see mathlib4#3024
@[simp]
lemma to_matrix_apply [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) (i j) :
  to_matrix f i j = if j ∈ f i then (1 : α) else 0 := rfl

lemma mul_matrix_apply [fintype m] [decidable_eq m] [semiring α] (f : l ≃. m) (M : matrix m n α)
  (i j) : (f.to_matrix ⬝ M) i j = option.cases_on (f i) 0 (λ fi, M fi j) :=
begin
  dsimp [to_matrix, matrix.mul_apply],
  cases h : f i with fi,
  { simp [h] },
  { rw finset.sum_eq_single fi;
    simp [h, eq_comm] {contextual := tt} }
end

lemma to_matrix_symm [decidable_eq m] [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) :
  (f.symm.to_matrix : matrix n m α) = f.to_matrixᵀ :=
by ext; simp only [transpose, mem_iff_mem f, to_matrix_apply]; congr

@[simp] lemma to_matrix_refl [decidable_eq n] [has_zero α] [has_one α] :
  ((pequiv.refl n).to_matrix : matrix n n α) = 1 :=
by ext; simp [to_matrix_apply, one_apply]; congr

lemma matrix_mul_apply [fintype m] [semiring α] [decidable_eq n] (M : matrix l m α) (f : m ≃. n)
  (i j) : (M ⬝ f.to_matrix) i j = option.cases_on (f.symm j) 0 (λ fj, M i fj) :=
begin
  dsimp [to_matrix, matrix.mul_apply],
  cases h : f.symm j with fj,
  { simp [h, ← f.eq_some_iff] },
  { rw finset.sum_eq_single fj,
    { simp [h, ← f.eq_some_iff], },
    { intros b H n, simp [h, ← f.eq_some_iff, n.symm], },
    { simp, } }
end

lemma to_pequiv_mul_matrix [fintype m] [decidable_eq m] [semiring α] (f : m ≃ m)
  (M : matrix m n α) : (f.to_pequiv.to_matrix ⬝ M) = λ i, M (f i) :=
by { ext i j, rw [mul_matrix_apply, equiv.to_pequiv_apply] }

lemma mul_to_pequiv_to_matrix {m n α : Type*} [fintype n] [decidable_eq n] [semiring α]
  (f : n ≃ n) (M : matrix m n α) : (M ⬝ f.to_pequiv.to_matrix) = M.submatrix id (f.symm) :=
matrix.ext $ λ i j, by rw [pequiv.matrix_mul_apply, ←equiv.to_pequiv_symm,
                           equiv.to_pequiv_apply, matrix.submatrix_apply, id.def]

lemma to_matrix_trans [fintype m] [decidable_eq m] [decidable_eq n] [semiring α]
  (f : l ≃. m) (g : m ≃. n) : ((f.trans g).to_matrix : matrix l n α) = f.to_matrix ⬝ g.to_matrix :=
begin
  ext i j,
  rw [mul_matrix_apply],
  dsimp [to_matrix, pequiv.trans],
  cases f i; simp
end

@[simp] lemma to_matrix_bot [decidable_eq n] [has_zero α] [has_one α] :
  ((⊥ : pequiv m n).to_matrix : matrix m n α) = 0 := rfl

lemma to_matrix_injective [decidable_eq n] [monoid_with_zero α] [nontrivial α] :
  function.injective (@to_matrix m n α _ _ _) :=
begin
  classical,
  assume f g,
  refine not_imp_not.1 _,
  simp only [matrix.ext_iff.symm, to_matrix_apply, pequiv.ext_iff,
    not_forall, exists_imp_distrib],
  assume i hi,
  use i,
  cases hf : f i with fi,
  { cases hg : g i with gi,
    { cc },
    { use gi,
      simp, } },
  { use fi,
    simp [hf.symm, ne.symm hi] }
end

lemma to_matrix_swap [decidable_eq n] [ring α] (i j : n) :
  (equiv.swap i j).to_pequiv.to_matrix =
  (1 : matrix n n α) - (single i i).to_matrix - (single j j).to_matrix + (single i j).to_matrix +
    (single j i).to_matrix :=
begin
  ext,
  dsimp [to_matrix, single, equiv.swap_apply_def, equiv.to_pequiv, one_apply],
  split_ifs; {simp * at *} <|> { exfalso, assumption },
end

@[simp] lemma single_mul_single [fintype n] [decidable_eq k] [decidable_eq m] [decidable_eq n]
  [semiring α] (a : m) (b : n) (c : k) :
  ((single a b).to_matrix : matrix _ _ α) ⬝ (single b c).to_matrix = (single a c).to_matrix :=
by rw [← to_matrix_trans, single_trans_single]

lemma single_mul_single_of_ne [fintype n] [decidable_eq n] [decidable_eq k]
  [decidable_eq m] [semiring α] {b₁ b₂ : n} (hb : b₁ ≠ b₂) (a : m) (c : k) :
  ((single a b₁).to_matrix : matrix _ _ α) ⬝ (single b₂ c).to_matrix = 0 :=
by rw [← to_matrix_trans, single_trans_single_of_ne hb, to_matrix_bot]

/-- Restatement of `single_mul_single`, which will simplify expressions in `simp` normal form,
  when associativity may otherwise need to be carefully applied. -/
@[simp] lemma single_mul_single_right [fintype n] [fintype k] [decidable_eq n] [decidable_eq k]
  [decidable_eq m] [semiring α] (a : m) (b : n) (c : k) (M : matrix k l α) :
  (single a b).to_matrix ⬝ ((single b c).to_matrix ⬝ M) = (single a c).to_matrix ⬝ M :=
by rw [← matrix.mul_assoc, single_mul_single]

/-- We can also define permutation matrices by permuting the rows of the identity matrix. -/

end pequiv


import group_theory.free_group
import extras.group_extras

universe u
variables {α : Type u} {L L₁ : list (α × bool)}

namespace free_group

lemma red.step.reverse (L L₁ : list (α × bool)) :
red.step L L₁ ↔ red.step (L.reverse) (L₁.reverse) :=
begin
  split,
  { intro h; induction h; simp },
  { intro h,
    generalize eq₁ : (L.reverse = L'),
    generalize eq₂ : (L₁.reverse = L₁),
    rw eq₁ at *, rw eq₂ at *,
    induction h,
    rw list.reverse_eq_iff at *,
    simp only [bnot, list.reverse_append, list.reverse_cons,
    list.append_assoc, list.singleton_append, list.cons_append] at *,
    rw [eq₁, eq₂],
    simp only [list.nil_append, red.step.bnot_rev]}
end

lemma red.reverse (L L₁ : list (α × bool)) :
red L L₁ → red (L.reverse) (L₁.reverse) :=
begin
  intro h,
  apply relation.refl_trans_gen.head_induction_on h,
  fconstructor,
  intros a c hac hcL₁ hcL₁rev,
  rw ← red at *,
  rw red.step.reverse at hac,
  have h₁ := red.step.to_red hac,
  exact red.trans h₁ hcL₁rev,
end

lemma red.reverse_iff (L L₁ : list (α × bool)) :
red (L.reverse) (L₁.reverse) ↔ red L L₁ :=
begin
  split,
  intro h,
  have h₁ := @red.reverse α  (L.reverse) (L₁.reverse) h,
  rw [list.reverse_reverse, list.reverse_reverse] at *,
  exacts [h₁, @red.reverse α L L₁],
end

lemma red.append_singleton_nil_iff (L : list (α × bool)) :
∀ {x : α} {b : bool}, red (L ++ [(x, b)]) [] ↔ red L [(x, !b)] :=
begin
  intros x b,
  rw ← red.reverse_iff,
  split,
  { intro h,
    simp only [list.reverse_append, list.reverse_singleton,
    list.singleton_append, list.reverse_nil] at *,
    rw red.cons_nil_iff_singleton at *,
    rw ← red.reverse_iff,
    simp only [list.reverse_singleton],
    exact h },
  { intro h,
    simp only [list.reverse_append, list.reverse_singleton,
    list.singleton_append, list.reverse_nil],
    rw red.cons_nil_iff_singleton at *,
    rw ← red.reverse_iff,
    simp only [list.reverse_reverse, list.reverse_singleton],
    exact h }
end

lemma mk_bnot : ∀ {x : α} {b : bool}, mk ([(x, b), (x, !b)]) = 1 :=
begin
  intros x b,
  rw [one_eq_mk, red.exact, relation.join],
  use ([]),
  exact ⟨red.cons_nil_iff_singleton.mpr red.refl, red.refl⟩,
end

lemma mk_one_iff {L : list (α × bool)}: mk L = 1 ↔ red L [] :=
begin
  split,
  { intro h,
    rw [one_eq_mk, red.exact] at h,
    rcases h with ⟨c, hl, hr⟩,
    rw red.nil_iff at hr,
    rw hr at hl,
    exact hl },
  { intro h,
    rw [one_eq_mk, red.exact],
    use ([]),
    exact ⟨h, red.refl⟩ }
end

theorem cons_one_exists_prefix_eq_one {L : list (α × bool)} {x : α} {b : bool} :
free_group.mk ((x, b) :: L ) = 1 →
(∃ e : list (α × bool), list.is_prefix (e ++ [(x, !b)]) L ∧ free_group.mk e = 1) :=
begin
  intro h,
  rw [one_eq_mk, red.exact, relation.join] at h,
  rcases h with ⟨L₁, hl, hr⟩,
  rw red.nil_iff at hr,
  rw [hr, red.cons_nil_iff_singleton] at hl,
  induction hl using relation.refl_trans_gen.head_induction_on with w w' hww' hw' ih,
  { use ([]),
    simp only [list.nil_append],
    exact ⟨list.prefix_rfl, rfl⟩ },
  { clear hr,
    induction hww' with p s a b',
    rcases ih with ⟨e, ihl, ihr⟩,
    rw list.is_prefix at ihl,
    cases ihl with t,
    simp only [list.append_assoc, list.singleton_append] at *,
    rw list.append_eq_append_iff at ihl_h,
    induction ihl_h,
    { rcases ihl_h with ⟨a', ihl_hl,ihl_hr⟩,
      rw list.cons_eq_append_iff at ihl_hr,
      induction ihl_hr,
      { use (e ++ (a, b') :: [(a, !b')]),
        split,
        { cases ihl_hr with h₁ h₂,
          rw [h₂, ihl_hl, h₁, list.is_prefix],
          use t,
          simp only [list.append_assoc, list.cons_append,
          list.singleton_append, list.append_nil] },
          { rw [← mul_mk, ihr, one_mul, free_group.mk_bnot] } },
          { rcases ihl_hr with ⟨a₁, h₁, h₂⟩,
            use e,
            rw h₁ at ihl_hl,
            rw [ihl_hl,  list.is_prefix],
            split,
            use (a₁ ++ (a, b') :: (a, !b') :: s),
            simp only [bnot, list.append_assoc, list.singleton_append,
            list.cons_append, eq_self_iff_true, list.nil_append],
            exact ihr } },
            { rcases ihl_h with ⟨c', h₁, h₂⟩,
              use (p ++ (a, b')::(a, !b')::c'),
              split,
              { rw [h₂, list.is_prefix],
                use t,
                simp only [list.append_assoc, list.cons_append, list.singleton_append] },
              { rw ← mul_mk,
                have h : (a, b') :: (a, !b') :: c' = [(a, b'),(a, !b')] ++ c', {
                  simp only [list.cons_append, list.singleton_append,
                  eq_self_iff_true, and_self] },
                rw [h, ← mul_mk, mk_bnot, one_mul,  mul_mk, ← h₁, ihr] } } }
end

theorem append_singleton_one_exists_suffix_eq_one {L : list (α × bool)} {x : α} {b : bool} :
free_group.mk (L ++ [(x, b)]) = 1 →
(∃ e : list (α × bool), list.is_suffix ((x, !b) :: e) L ∧ free_group.mk e = 1) :=
begin
  intro h,
  rw [one_eq_mk, red.exact, relation.join] at h,
  rcases h with ⟨L₁, hl, hr⟩,
  rw red.nil_iff at hr,
  rw hr at hl,
  rw ← red.reverse_iff at hl,
  simp only [list.reverse_append, list.reverse_singleton,
  list.singleton_append, list.reverse_nil] at hl,
  have h₁ : mk ((x, b)::L.reverse) = 1, {
    rw [one_eq_mk, red.exact],
    use ([]),
    exact ⟨hl, red.refl⟩ },
  have h₂ := cons_one_exists_prefix_eq_one h₁,
  rcases h₂ with ⟨e, _, _⟩,
  use (e.reverse),
  split,
  { refine list.reverse_prefix.mp _,
    simp only [list.reverse_cons, list.reverse_reverse],
    exact h₂_h_left } ,
  { rw [one_eq_mk, red.exact],
    use ([]),
    rw [one_eq_mk, red.exact, relation.join] at h₂_h_right,
    rcases h₂_h_right with ⟨c, _, _⟩,
    rw red.nil_iff at h₂_h_right_h_right,
    rw [h₂_h_right_h_right, ← red.reverse_iff ] at h₂_h_right_h_left,
    simp only [list.reverse_nil] at *,
    exact ⟨h₂_h_right_h_left, red.refl⟩ }
end

theorem append_cons_one_exists_suffix_or_prefix_eq_one {L L₁ : list (α × bool)} {x : α} {b : bool} :
free_group.mk (L ++ (x, b) :: L₁ ) = 1  →
(∃ e : list (α × bool), list.is_suffix ((x, !b) :: e) L ∧ free_group.mk e = 1) ∨
(∃ e : list (α × bool), list.is_prefix (e ++ [(x, !b)]) L₁ ∧ free_group.mk e = 1) :=
begin
  intro h,
  { have h₁ : mk ((x, b)::(L₁ ++ L)) = 1, {
      rw [← mul_mk, ← list.singleton_append,
      ← mul_mk, ← mul_assoc, group.basic.mul_mul_mul_eq_one_iff] at h,
      repeat { rw mul_mk at h },
      simp only [list.singleton_append, list.cons_append] at h,
      exact h },
    have h₂ : mk (L₁ ++ L ++ [(x, b)]) = 1, by {
      rw [← mul_mk, ← list.singleton_append,
      ← mul_mk, ← mul_assoc, group.basic.mul_mul_mul_eq_one_iff'] at h,
      repeat { rw mul_mk at h },
      simp only [list.append_assoc] at h,
      rw ← list.append_assoc at h,
      exact h },
    have h₃ := cons_one_exists_prefix_eq_one h₁,
    rcases h₃ with ⟨e, h₄, h₅⟩,
    rw list.is_prefix at h₄,
    cases h₄ with t h₄,
    simp only [list.append_assoc, list.singleton_append] at *,
    rw list.append_eq_append_iff at h₄,
    induction h₄,
    { rcases h₄ with ⟨a, h₆, h₇⟩,
      rw list.cons_eq_append_iff at h₇,
      induction h₇,
      { rw h₇.1 at h₆,
        simp only [list.append_nil] at *,
        have h₈ : mk (L ++ [(x,b)]) = 1, {
          rw ← list.singleton_append at h₁,
          rw [← mul_mk, ← mul_mk,
          h₆, h₅, one_mul, mul_mk] at h₂,
          exact h₂ },
        left,
        exact append_singleton_one_exists_suffix_eq_one h₈ },
      { rcases h₇ with ⟨a', h₈, h₉⟩,
        right, use e, rw h₆,
        split,
        { rw h₈, use a',
          simp only [list.append_assoc, list.singleton_append] },
        { exact h₅ } } },
    { rcases h₄ with ⟨c, h₆, h₇⟩,
      rw [h₇, ← list.append_assoc, ← h₆]  at h₁,
      left, use t,
      split,
      { rw list.is_suffix,
        use c, exact h₇.symm },
      { have h₈ : (x, b) :: (e ++ (x, !b) :: t) = [(x, b)] ++ e ++ [(x, !b)] ++ t, {
        simp only [bnot, list.singleton_append, list.cons_append,
        list.append_assoc, prod.mk.inj_iff, eq_self_iff_true, and_self],
        split,
        exact trivial,
        simp only [list.nil_append] },
        rw h₈ at h₁,
        repeat { rw ← mul_mk at h₁ },
        rw [h₅, mul_one, mul_mk,
        list.singleton_append,
        mk_bnot, one_mul] at h₁,
        exact h₁ } } }
end

end free_group


import data.real.basic

variables (u v w : ℕ → ℝ) (l l' : ℝ)

notation `|`x`|` := abs x

-- l es el límite de la sucesión u
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

-- 1ª demostración
example
  (hu : seq_limit u l)
  (hw : seq_limit w l)
  (h : ∀ n, u n ≤ v n)
  (h' : ∀ n, v n ≤ w n) :
  seq_limit v l :=
begin
  intros ε hε,
  cases hu ε hε with N hN,
  cases hw ε hε with M hM,
  use (max N M),
  intros n hn,
  specialize hN n (le_of_max_le_left hn),
  specialize hM n (le_of_max_le_right hn),
  rw [abs_le] at *,
  specialize h n,
  specialize h' n,
  split; linarith,
end

-- 2ª demostración
example
  (hu : seq_limit u l)
  (hw : seq_limit w l)
  (h : ∀ n, u n ≤ v n)
  (h' : ∀ n, v n ≤ w n) :
  seq_limit v l :=
begin
  intros ε hε,
  cases hu ε hε with N hN,
  cases hw ε hε with M hM,
  use (max N M),
  intros n hn,
  specialize hN n (le_of_max_le_left hn),
  specialize hM n (le_of_max_le_right hn),
  rw abs_le at *,
  split; linarith [h n, h' n],
end