/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import tactic.pi_instances
import algebra.group.pi
import algebra.hom.ring

/-!
# Pi instances for ring

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

This file defines instances for ring, semiring and related structures on Pi Types
-/

namespace pi
universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

instance distrib [Π i, distrib $ f i] : distrib (Π i : I, f i) :=
by refine_struct { add := (+), mul := (*), .. }; tactic.pi_instance_derive_field

instance non_unital_non_assoc_semiring [∀ i, non_unital_non_assoc_semiring $ f i] :
  non_unital_non_assoc_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance non_unital_semiring [∀ i, non_unital_semiring $ f i] :
  non_unital_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance non_assoc_semiring [∀ i, non_assoc_semiring $ f i] :
  non_assoc_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance semiring [∀ i, semiring $ f i] : semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := add_monoid.nsmul, npow := monoid.npow };
tactic.pi_instance_derive_field

instance non_unital_comm_semiring [∀ i, non_unital_comm_semiring $ f i] :
  non_unital_comm_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), nsmul := add_monoid.nsmul };
tactic.pi_instance_derive_field

instance comm_semiring [∀ i, comm_semiring $ f i] : comm_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := add_monoid.nsmul, npow := monoid.npow };
tactic.pi_instance_derive_field

instance non_unital_non_assoc_ring [∀ i, non_unital_non_assoc_ring $ f i] :
  non_unital_non_assoc_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul };
tactic.pi_instance_derive_field

instance non_unital_ring [∀ i, non_unital_ring $ f i] :
  non_unital_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul };
tactic.pi_instance_derive_field

instance non_assoc_ring [∀ i, non_assoc_ring $ f i] :
  non_assoc_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul };
tactic.pi_instance_derive_field

instance ring [∀ i, ring $ f i] : ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul,
  npow := monoid.npow };
tactic.pi_instance_derive_field

instance non_unital_comm_ring [∀ i, non_unital_comm_ring $ f i] :
  non_unital_comm_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), neg := has_neg.neg,
  nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul };
tactic.pi_instance_derive_field

instance comm_ring [∀ i, comm_ring $ f i] : comm_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul,
  npow := monoid.npow };
tactic.pi_instance_derive_field

/-- A family of non-unital ring homomorphisms `f a : γ →ₙ+* β a` defines a non-unital ring
homomorphism `pi.non_unital_ring_hom f : γ →+* Π a, β a` given by
`pi.non_unital_ring_hom f x b = f b x`. -/
@[simps]
protected def non_unital_ring_hom {γ : Type w} [Π i, non_unital_non_assoc_semiring (f i)]
  [non_unital_non_assoc_semiring γ] (g : Π i, γ →ₙ+* f i) : γ →ₙ+* Π i, f i :=
{ to_fun := λ x b, g b x,
  .. pi.mul_hom (λ i, (g i).to_mul_hom),
  .. pi.add_monoid_hom (λ i, (g i).to_add_monoid_hom) }

lemma non_unital_ring_hom_injective {γ : Type w} [nonempty I]
  [Π i, non_unital_non_assoc_semiring (f i)] [non_unital_non_assoc_semiring γ] (g : Π i, γ →ₙ+* f i)
  (hg : ∀ i, function.injective (g i)) : function.injective (pi.non_unital_ring_hom g) :=
mul_hom_injective (λ i, (g i).to_mul_hom) hg

/-- A family of ring homomorphisms `f a : γ →+* β a` defines a ring homomorphism
`pi.ring_hom f : γ →+* Π a, β a` given by `pi.ring_hom f x b = f b x`. -/
@[simps]
protected def ring_hom {γ : Type w} [Π i, non_assoc_semiring (f i)] [non_assoc_semiring γ]
  (g : Π i, γ →+* f i) : γ →+* Π i, f i :=
{ to_fun := λ x b, g b x,
  .. pi.monoid_hom (λ i, (g i).to_monoid_hom),
  .. pi.add_monoid_hom (λ i, (g i).to_add_monoid_hom) }

lemma ring_hom_injective {γ : Type w} [nonempty I] [Π i, non_assoc_semiring (f i)]
  [non_assoc_semiring γ] (g : Π i, γ →+* f i) (hg : ∀ i, function.injective (g i)) :
  function.injective (pi.ring_hom g) :=
monoid_hom_injective (λ i, (g i).to_monoid_hom) hg

end pi

section non_unital_ring_hom

universes u v
variable {I : Type u}

/-- Evaluation of functions into an indexed collection of non-unital rings at a point is a
non-unital ring homomorphism. This is `function.eval` as a `non_unital_ring_hom`. -/
@[simps]
def pi.eval_non_unital_ring_hom (f : I → Type v)
  [Π i, non_unital_non_assoc_semiring (f i)] (i : I) : (Π i, f i) →ₙ+* f i :=
{ ..(pi.eval_mul_hom f i),
  ..(pi.eval_add_monoid_hom f i) }

/-- `function.const` as a `non_unital_ring_hom`. -/
@[simps]
def pi.const_non_unital_ring_hom (α β : Type*) [non_unital_non_assoc_semiring β] : β →ₙ+* (α → β) :=
{ to_fun := function.const _,
  .. pi.non_unital_ring_hom (λ _, non_unital_ring_hom.id β) }

/-- Non-unital ring homomorphism between the function spaces `I → α` and `I → β`, induced by a
non-unital ring homomorphism `f` between `α` and `β`. -/
@[simps] protected def non_unital_ring_hom.comp_left {α β : Type*} [non_unital_non_assoc_semiring α]
  [non_unital_non_assoc_semiring β] (f : α →ₙ+* β) (I : Type*) :
  (I → α) →ₙ+* (I → β) :=
{ to_fun := λ h, f ∘ h,
  .. f.to_mul_hom.comp_left I,
  .. f.to_add_monoid_hom.comp_left I }

end non_unital_ring_hom

section ring_hom

universes u v
variable {I : Type u}

/-- Evaluation of functions into an indexed collection of rings at a point is a ring
homomorphism. This is `function.eval` as a `ring_hom`. -/
@[simps]
def pi.eval_ring_hom (f : I → Type v) [Π i, non_assoc_semiring (f i)] (i : I) :
  (Π i, f i) →+* f i :=
{ ..(pi.eval_monoid_hom f i),
  ..(pi.eval_add_monoid_hom f i) }

/-- `function.const` as a `ring_hom`. -/
@[simps]
def pi.const_ring_hom (α β : Type*) [non_assoc_semiring β] : β →+* (α → β) :=
{ to_fun := function.const _,
  .. pi.ring_hom (λ _, ring_hom.id β) }

/-- Ring homomorphism between the function spaces `I → α` and `I → β`, induced by a ring
homomorphism `f` between `α` and `β`. -/
@[simps] protected def ring_hom.comp_left {α β : Type*} [non_assoc_semiring α]
  [non_assoc_semiring β] (f : α →+* β) (I : Type*) :
  (I → α) →+* (I → β) :=
{ to_fun := λ h, f ∘ h,
  .. f.to_monoid_hom.comp_left I,
  .. f.to_add_monoid_hom.comp_left I }

end ring_hom


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.bool.basic
import Mathlib.Lean3Lib.init.meta.default

universes u

namespace Mathlib

@[simp] theorem cond_a_a {α : Type u} (b : Bool) (a : α) : cond b a a = a := sorry

@[simp] theorem band_self (b : Bool) : b && b = b := sorry

@[simp] theorem band_tt (b : Bool) : b && tt = b := sorry

@[simp] theorem band_ff (b : Bool) : b && false = false := sorry

@[simp] theorem tt_band (b : Bool) : tt && b = b := sorry

@[simp] theorem ff_band (b : Bool) : false && b = false := sorry

@[simp] theorem bor_self (b : Bool) : b || b = b := sorry

@[simp] theorem bor_tt (b : Bool) : b || tt = tt := sorry

@[simp] theorem bor_ff (b : Bool) : b || false = b := sorry

@[simp] theorem tt_bor (b : Bool) : tt || b = tt := sorry

@[simp] theorem ff_bor (b : Bool) : false || b = b := sorry

@[simp] theorem bxor_self (b : Bool) : bxor b b = false := sorry

@[simp] theorem bxor_tt (b : Bool) : bxor b tt = bnot b := sorry

@[simp] theorem bxor_ff (b : Bool) : bxor b false = b := sorry

@[simp] theorem tt_bxor (b : Bool) : bxor tt b = bnot b := sorry

@[simp] theorem ff_bxor (b : Bool) : bxor false b = b := sorry

@[simp] theorem bnot_bnot (b : Bool) : bnot (bnot b) = b := sorry

@[simp] theorem tt_eq_ff_eq_false : ¬tt = false := id fun (ᾰ : tt = false) => bool.no_confusion ᾰ

@[simp] theorem ff_eq_tt_eq_false : ¬false = tt := id fun (ᾰ : false = tt) => bool.no_confusion ᾰ

@[simp] theorem eq_ff_eq_not_eq_tt (b : Bool) : (¬b = tt) = (b = false) := sorry

@[simp] theorem eq_tt_eq_not_eq_ff (b : Bool) : (¬b = false) = (b = tt) := sorry

theorem eq_ff_of_not_eq_tt {b : Bool} : ¬b = tt → b = false := eq.mp (eq_ff_eq_not_eq_tt b)

theorem eq_tt_of_not_eq_ff {b : Bool} : ¬b = false → b = tt := eq.mp (eq_tt_eq_not_eq_ff b)

@[simp] theorem band_eq_true_eq_eq_tt_and_eq_tt (a : Bool) (b : Bool) :
    a && b = tt = (a = tt ∧ b = tt) :=
  sorry

@[simp] theorem bor_eq_true_eq_eq_tt_or_eq_tt (a : Bool) (b : Bool) :
    a || b = tt = (a = tt ∨ b = tt) :=
  sorry

@[simp] theorem bnot_eq_true_eq_eq_ff (a : Bool) : bnot a = tt = (a = false) := sorry

@[simp] theorem band_eq_false_eq_eq_ff_or_eq_ff (a : Bool) (b : Bool) :
    a && b = false = (a = false ∨ b = false) :=
  sorry

@[simp] theorem bor_eq_false_eq_eq_ff_and_eq_ff (a : Bool) (b : Bool) :
    a || b = false = (a = false ∧ b = false) :=
  sorry

@[simp] theorem bnot_eq_ff_eq_eq_tt (a : Bool) : bnot a = false = (a = tt) := sorry

@[simp] theorem coe_ff : ↑false = False := sorry

@[simp] theorem coe_tt : ↑tt = True := sorry

@[simp] theorem coe_sort_ff : ↥false = False := sorry

@[simp] theorem coe_sort_tt : ↥tt = True := sorry

@[simp] theorem to_bool_iff (p : Prop) [d : Decidable p] : to_bool p = tt ↔ p := sorry

theorem to_bool_true {p : Prop} [Decidable p] : p → ↥(to_bool p) := iff.mpr (to_bool_iff p)

theorem to_bool_tt {p : Prop} [Decidable p] : p → to_bool p = tt := to_bool_true

theorem of_to_bool_true {p : Prop} [Decidable p] : ↥(to_bool p) → p := iff.mp (to_bool_iff p)

theorem bool_iff_false {b : Bool} : ¬↥b ↔ b = false :=
  bool.cases_on b (of_as_true trivial) (of_as_true trivial)

theorem bool_eq_false {b : Bool} : ¬↥b → b = false := iff.mp bool_iff_false

@[simp] theorem to_bool_ff_iff (p : Prop) [Decidable p] : to_bool p = false ↔ ¬p :=
  iff.trans (iff.symm bool_iff_false) (not_congr (to_bool_iff p))

theorem to_bool_ff {p : Prop} [Decidable p] : ¬p → to_bool p = false := iff.mpr (to_bool_ff_iff p)

theorem of_to_bool_ff {p : Prop} [Decidable p] : to_bool p = false → ¬p := iff.mp (to_bool_ff_iff p)

theorem to_bool_congr {p : Prop} {q : Prop} [Decidable p] [Decidable q] (h : p ↔ q) :
    to_bool p = to_bool q :=
  sorry

@[simp] theorem bor_coe_iff (a : Bool) (b : Bool) : ↥(a || b) ↔ ↥a ∨ ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem band_coe_iff (a : Bool) (b : Bool) : ↥(a && b) ↔ ↥a ∧ ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem bxor_coe_iff (a : Bool) (b : Bool) : ↥(bxor a b) ↔ xor ↥a ↥b :=
  bool.cases_on a (bool.cases_on b (of_as_true trivial) (of_as_true trivial))
    (bool.cases_on b (of_as_true trivial) (of_as_true trivial))

@[simp] theorem ite_eq_tt_distrib (c : Prop) [Decidable c] (a : Bool) (b : Bool) :
    ite c a b = tt = ite c (a = tt) (b = tt) :=
  sorry

@[simp] theorem ite_eq_ff_distrib (c : Prop) [Decidable c] (a : Bool) (b : Bool) :
    ite c a b = false = ite c (a = false) (b = false) :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.basic
import algebra.graded_monoid
import algebra.direct_sum.basic
import algebra.big_operators.pi

/-!
# Additively-graded multiplicative structures on `⨁ i, A i`

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over `⨁ i, A i` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an
additively-graded ring. The typeclasses are:

* `direct_sum.gnon_unital_non_assoc_semiring A`
* `direct_sum.gsemiring A`
* `direct_sum.gcomm_semiring A`

Respectively, these imbue the external direct sum `⨁ i, A i` with:

* `direct_sum.non_unital_non_assoc_semiring`
* `direct_sum.semiring`, `direct_sum.ring`
* `direct_sum.comm_semiring`, `direct_sum.comm_ring`

the base ring `A 0` with:

* `direct_sum.grade_zero.non_unital_non_assoc_semiring`
* `direct_sum.grade_zero.semiring`, `direct_sum.grade_zero.ring`
* `direct_sum.grade_zero.comm_semiring`, `direct_sum.grade_zero.comm_ring`

and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication:

* `direct_sum.grade_zero.has_scalar (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)`
* `direct_sum.grade_zero.module (A 0)`
* (nothing)

Note that in the presence of these instances, `⨁ i, A i` itself inherits an `A 0`-action.

`direct_sum.of_zero_ring_hom : A 0 →+* ⨁ i, A i` provides `direct_sum.of A 0` as a ring
homomorphism.

`direct_sum.to_semiring` extends `direct_sum.to_add_monoid` to produce a `ring_hom`.

## Direct sums of subobjects

Additionally, this module provides helper functions to construct `gsemiring` and `gcomm_semiring`
instances for:

* `A : ι → submonoid S`:
  `direct_sum.gsemiring.of_add_submonoids`, `direct_sum.gcomm_semiring.of_add_submonoids`.
* `A : ι → subgroup S`:
  `direct_sum.gsemiring.of_add_subgroups`, `direct_sum.gcomm_semiring.of_add_subgroups`.
* `A : ι → submodule S`:
  `direct_sum.gsemiring.of_submodules`, `direct_sum.gcomm_semiring.of_submodules`.

If `complete_lattice.independent (set.range A)`, these provide a gradation of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

graded ring, filtered ring, direct sum, add_submonoid
-/

set_option old_structure_cmd true

variables {ι : Type*} [decidable_eq ι]

namespace direct_sum

open_locale direct_sum

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*)

/-- A graded version of `non_unital_non_assoc_semiring`. -/
class gnon_unital_non_assoc_semiring [has_add ι] [Π i, add_comm_monoid (A i)] extends
  graded_monoid.ghas_mul A :=
(mul_zero : ∀ {i j} (a : A i), mul a (0 : A j) = 0)
(zero_mul : ∀ {i j} (b : A j), mul (0 : A i) b = 0)
(mul_add : ∀ {i j} (a : A i) (b c : A j), mul a (b + c) = mul a b + mul a c)
(add_mul : ∀ {i j} (a b : A i) (c : A j), mul (a + b) c = mul a c + mul b c)

end defs

section defs

variables (A : ι → Type*)

/-- A graded version of `semiring`. -/
class gsemiring [add_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gnon_unital_non_assoc_semiring A, graded_monoid.gmonoid A

/-- A graded version of `comm_semiring`. -/
class gcomm_semiring [add_comm_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gsemiring A, graded_monoid.gcomm_monoid A

end defs

lemma of_eq_of_graded_monoid_eq {A : ι → Type*} [Π (i : ι), add_comm_monoid (A i)]
  {i j : ι} {a : A i} {b : A j} (h : graded_monoid.mk i a = graded_monoid.mk j b) :
  direct_sum.of A i a = direct_sum.of A j b :=
dfinsupp.single_eq_of_sigma_eq h

variables (A : ι → Type*)

/-! ### Instances for `⨁ i, A i` -/

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

instance : has_one (⨁ i, A i) :=
{ one := direct_sum.of (λ i, A i) 0 graded_monoid.ghas_one.one}

end one

section mul
variables [has_add ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

open add_monoid_hom (flip_apply coe_comp comp_hom_apply_apply)

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps]
def gmul_hom {i j} : A i →+ A j →+ A (i + j) :=
{ to_fun := λ a,
  { to_fun := λ b, graded_monoid.ghas_mul.mul a b,
    map_zero' := gnon_unital_non_assoc_semiring.mul_zero _,
    map_add' := gnon_unital_non_assoc_semiring.mul_add _ },
  map_zero' := add_monoid_hom.ext $ λ a, gnon_unital_non_assoc_semiring.zero_mul a,
  map_add' := λ a₁ a₂, add_monoid_hom.ext $ λ b, gnon_unital_non_assoc_semiring.add_mul _ _ _}

/-- The multiplication from the `has_mul` instance, as a bundled homomorphism. -/
def mul_hom : (⨁ i, A i) →+ (⨁ i, A i) →+ ⨁ i, A i :=
direct_sum.to_add_monoid $ λ i,
  add_monoid_hom.flip $ direct_sum.to_add_monoid $ λ j, add_monoid_hom.flip $
    (direct_sum.of A _).comp_hom.comp $ gmul_hom A

instance : non_unital_non_assoc_semiring (⨁ i, A i) :=
{ mul := λ a b, mul_hom A a b,
  zero := 0,
  add := (+),
  zero_mul := λ a, by simp only [add_monoid_hom.map_zero, add_monoid_hom.zero_apply],
  mul_zero := λ a, by simp only [add_monoid_hom.map_zero],
  left_distrib := λ a b c, by simp only [add_monoid_hom.map_add],
  right_distrib := λ a b c, by simp only [add_monoid_hom.map_add, add_monoid_hom.add_apply],
  .. direct_sum.add_comm_monoid _ _}

variables {A}

lemma mul_hom_of_of {i j} (a : A i) (b : A j) :
  mul_hom A (of _ i a) (of _ j b) = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
begin
  unfold mul_hom,
  rw [to_add_monoid_of, flip_apply, to_add_monoid_of, flip_apply, coe_comp, function.comp_app,
      comp_hom_apply_apply, coe_comp, function.comp_app, gmul_hom_apply_apply],
end

lemma of_mul_of {i j} (a : A i) (b : A j) :
  of _ i a * of _ j b = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
mul_hom_of_of a b

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

open add_monoid_hom (flip_hom coe_comp comp_hom_apply_apply flip_apply flip_hom_apply)

private lemma one_mul (x : ⨁ i, A i) : 1 * x = x :=
suffices mul_hom A 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw mul_hom_of_of,
  exact of_eq_of_graded_monoid_eq (one_mul $ graded_monoid.mk i xi),
end

private lemma mul_one (x : ⨁ i, A i) : x * 1 = x :=
suffices (mul_hom A).flip 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw [flip_apply, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_one $ graded_monoid.mk i xi),
end

private lemma mul_assoc (a b c : ⨁ i, A i) : a * b * c = a * (b * c) :=
suffices (mul_hom A).comp_hom.comp (mul_hom A)            -- `λ a b c, a * b * c` as a bundled hom
       = (add_monoid_hom.comp_hom flip_hom $              -- `λ a b c, a * (b * c)` as a bundled hom
             (mul_hom A).flip.comp_hom.comp (mul_hom A)).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b) c,
begin
  ext ai ax bi bx ci cx : 6,
  dsimp only [coe_comp, function.comp_app, comp_hom_apply_apply, flip_apply, flip_hom_apply],
  rw [mul_hom_of_of, mul_hom_of_of, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_assoc (graded_monoid.mk ai ax) ⟨bi, bx⟩ ⟨ci, cx⟩),
end

/-- The `semiring` structure derived from `gsemiring A`. -/
instance semiring : semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  one_mul := one_mul A,
  mul_one := mul_one A,
  mul_assoc := mul_assoc A,
  ..direct_sum.non_unital_non_assoc_semiring _, }

lemma of_pow {i} (a : A i) (n : ℕ) :
  of _ i a ^ n = of _ (n • i) (graded_monoid.gmonoid.gnpow _ a) :=
begin
  induction n with n,
  { exact of_eq_of_graded_monoid_eq (pow_zero $ graded_monoid.mk _ a).symm, },
  { rw [pow_succ, n_ih, of_mul_of],
    exact of_eq_of_graded_monoid_eq (pow_succ (graded_monoid.mk _ a) n).symm, },
end

open_locale big_operators

/-- A heavily unfolded version of the definition of multiplication -/
lemma mul_eq_sum_support_ghas_mul
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
  a * a' =
    ∑ (ij : ι × ι) in (dfinsupp.support a).product (dfinsupp.support a'),
      direct_sum.of _ _ (graded_monoid.ghas_mul.mul (a ij.fst) (a' ij.snd)) :=
begin
  change direct_sum.mul_hom _ a a' = _,
  dsimp [direct_sum.mul_hom, direct_sum.to_add_monoid, dfinsupp.lift_add_hom_apply],
  simp only [dfinsupp.sum_add_hom_apply, dfinsupp.sum, dfinsupp.finset_sum_apply,
    add_monoid_hom.coe_sum, finset.sum_apply, add_monoid_hom.flip_apply,
    add_monoid_hom.comp_hom_apply_apply, add_monoid_hom.comp_apply,
    direct_sum.gmul_hom_apply_apply],
  rw finset.sum_product,
end

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

private lemma mul_comm (a b : ⨁ i, A i) : a * b = b * a :=
suffices mul_hom A = (mul_hom A).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b,
begin
  apply add_hom_ext, intros ai ax, apply add_hom_ext, intros bi bx,
  rw [add_monoid_hom.flip_apply, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (gcomm_semiring.mul_comm ⟨ai, ax⟩ ⟨bi, bx⟩),
end

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance comm_semiring : comm_semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  mul_comm := mul_comm A,
  ..direct_sum.semiring _, }

end comm_semiring

section ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gsemiring A]

/-- The `ring` derived from `gsemiring A`. -/
instance ring : ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.semiring _),
  ..(direct_sum.add_comm_group _), }

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_semiring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance comm_ring : comm_ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.ring _),
  ..(direct_sum.comm_semiring _), }

end comm_ring

/-! ### Instances for `A 0`

The various `g*` instances are enough to promote the `add_comm_monoid (A 0)` structure to various
types of multiplicative structure.
-/

section grade_zero

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

@[simp] lemma of_zero_one : of _ 0 (1 : A 0) = 1 := rfl

end one

section mul
variables [add_monoid ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

@[simp] lemma of_zero_smul {i} (a : A 0) (b : A i) : of _ _ (a • b) = of _ _ a * of _ _ b :=
(of_eq_of_graded_monoid_eq (graded_monoid.mk_zero_smul a b)).trans (of_mul_of _ _).symm

@[simp] lemma of_zero_mul (a b : A 0) : of _ 0 (a * b) = of _ 0 a * of _ 0 b:=
of_zero_smul A a b

instance grade_zero.non_unital_non_assoc_semiring : non_unital_non_assoc_semiring (A 0) :=
function.injective.non_unital_non_assoc_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of A 0).map_add (of_zero_mul A)

instance grade_zero.smul_with_zero (i : ι) : smul_with_zero (A 0) (A i) :=
begin
  letI := smul_with_zero.comp_hom (⨁ i, A i) (of A 0).to_zero_hom,
  refine dfinsupp.single_injective.smul_with_zero (of A i).to_zero_hom (of_zero_smul A),
end

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

/-- The `semiring` structure derived from `gsemiring A`. -/
instance grade_zero.semiring : semiring (A 0) :=
function.injective.semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)

/-- `of A 0` is a `ring_hom`, using the `direct_sum.grade_zero.semiring` structure. -/
def of_zero_ring_hom : A 0 →+* (⨁ i, A i) :=
{ map_one' := of_zero_one A, map_mul' := of_zero_mul A, ..(of _ 0) }

/-- Each grade `A i` derives a `A 0`-module structure from `gsemiring A`. Note that this results
in an overall `module (A 0) (⨁ i, A i)` structure via `direct_sum.module`.
-/
instance grade_zero.module {i} : module (A 0) (A i) :=
begin
  letI := module.comp_hom (⨁ i, A i) (of_zero_ring_hom A),
  exact dfinsupp.single_injective.module (A 0) (of A i) (λ a, of_zero_smul A a),
end

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance grade_zero.comm_semiring : comm_semiring (A 0) :=
function.injective.comm_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)

end comm_semiring

section ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gsemiring A]

/-- The `ring` derived from `gsemiring A`. -/
instance grade_zero.ring : ring (A 0) :=
function.injective.ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_semiring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance grade_zero.comm_ring : comm_ring (A 0) :=
function.injective.comm_ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub

end comm_ring

end grade_zero

section to_semiring

variables {R : Type*} [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A] [semiring R]
variables {A}

/-- If two ring homomorphisms from `⨁ i, A i` are equal on each `of A i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma ring_hom_ext' (F G : (⨁ i, A i) →+* R)
  (h : ∀ i, (F : (⨁ i, A i) →+ R).comp (of _ i) = (G : (⨁ i, A i) →+ R).comp (of _ i)) : F = G :=
ring_hom.coe_add_monoid_hom_injective $ direct_sum.add_hom_ext' h

/-- A family of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
describes a `ring_hom`s on `⨁ i, A i`. This is a stronger version of `direct_sum.to_monoid`.

Of particular interest is the case when `A i` are bundled subojects, `f` is the family of
coercions such as `add_submonoid.subtype (A i)`, and the `[gsemiring A]` structure originates from
`direct_sum.gsemiring.of_add_submonoids`, in which case the proofs about `ghas_one` and `ghas_mul`
can be discharged by `rfl`. -/
@[simps]
def to_semiring
  (f : Π i, A i →+ R) (hone : f _ (graded_monoid.ghas_one.one) = 1)
  (hmul : ∀ {i j} (ai : A i) (aj : A j), f _ (graded_monoid.ghas_mul.mul ai aj) = f _ ai * f _ aj) :
  (⨁ i, A i) →+* R :=
{ to_fun := to_add_monoid f,
  map_one' := begin
    change (to_add_monoid f) (of _ 0 _) = 1,
    rw to_add_monoid_of,
    exact hone
  end,
  map_mul' := begin
    rw (to_add_monoid f).map_mul_iff,
    ext xi xv yi yv : 4,
    show to_add_monoid f (of A xi xv * of A yi yv) =
         to_add_monoid f (of A xi xv) * to_add_monoid f (of A yi yv),
    rw [of_mul_of, to_add_monoid_of, to_add_monoid_of, to_add_monoid_of],
    exact hmul _ _,
  end,
  .. to_add_monoid f}

@[simp] lemma to_semiring_of (f : Π i, A i →+ R) (hone hmul) (i : ι) (x : A i) :
  to_semiring f hone hmul (of _ i x) = f _ x :=
to_add_monoid_of f i x

@[simp] lemma to_semiring_coe_add_monoid_hom (f : Π i, A i →+ R) (hone hmul):
  (to_semiring f hone hmul : (⨁ i, A i) →+ R) = to_add_monoid f := rfl

/-- Families of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
are isomorphic to `ring_hom`s on `⨁ i, A i`. This is a stronger version of `dfinsupp.lift_add_hom`.
-/
@[simps]
def lift_ring_hom :
  {f : Π {i}, A i →+ R //
    f (graded_monoid.ghas_one.one) = 1 ∧
    ∀ {i j} (ai : A i) (aj : A j), f (graded_monoid.ghas_mul.mul ai aj) = f ai * f aj} ≃
    ((⨁ i, A i) →+* R) :=
{ to_fun := λ f, to_semiring f.1 f.2.1 f.2.2,
  inv_fun := λ F,
    ⟨λ i, (F : (⨁ i, A i) →+ R).comp (of _ i), begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw ←F.map_one,
      refl
    end, λ i j ai aj, begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw [←F.map_mul, of_mul_of],
    end⟩,
  left_inv := λ f, begin
    ext xi xv,
    exact to_add_monoid_of f.1 xi xv,
  end,
  right_inv := λ F, begin
    apply ring_hom.coe_add_monoid_hom_injective,
    ext xi xv,
    simp only [ring_hom.coe_add_monoid_hom_mk,
      direct_sum.to_add_monoid_of,
      add_monoid_hom.mk_coe,
      add_monoid_hom.comp_apply, to_semiring_coe_add_monoid_hom],
  end}

/-- Two `ring_hom`s out of a direct sum are equal if they agree on the generators.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma ring_hom_ext ⦃f g : (⨁ i, A i) →+* R⦄
  (h : ∀ i, (↑f : (⨁ i, A i) →+ R).comp (of A i) = (↑g : (⨁ i, A i) →+ R).comp (of A i)) :
  f = g :=
direct_sum.lift_ring_hom.symm.injective $ subtype.ext $ funext h

end to_semiring

end direct_sum

/-! ### Concrete instances -/

section uniform

variables (ι)

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring
  {R : Type*} [add_monoid ι] [non_unital_non_assoc_semiring R] :
  direct_sum.gnon_unital_non_assoc_semiring (λ i : ι, R) :=
{ mul_zero := λ i j, mul_zero,
  zero_mul := λ i j, zero_mul,
  mul_add := λ i j, mul_add,
  add_mul := λ i j, add_mul,
  ..has_mul.ghas_mul ι }

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance semiring.direct_sum_gsemiring {R : Type*} [add_monoid ι] [semiring R] :
  direct_sum.gsemiring (λ i : ι, R) :=
{ ..non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring ι, ..monoid.gmonoid ι }

open_locale direct_sum

-- To check `has_mul.ghas_mul_mul` matches
example {R : Type*} [add_monoid ι] [semiring R] (i j : ι) (a b : R) :
  (direct_sum.of _ i a * direct_sum.of _ j b : ⨁ i, R) = direct_sum.of _ (i + j) (by exact a * b) :=
by rw [direct_sum.of_mul_of, has_mul.ghas_mul_mul]

/-- A direct sum of copies of a `comm_semiring` inherits the commutative multiplication structure.
-/
instance comm_semiring.direct_sum_gcomm_semiring {R : Type*} [add_comm_monoid ι] [comm_semiring R] :
  direct_sum.gcomm_semiring (λ i : ι, R) :=
{ ..comm_monoid.gcomm_monoid ι, ..semiring.direct_sum_gsemiring ι }

end uniform


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker

! This file was ported from Lean 3 source module data.polynomial.identities
! leanprover-community/mathlib commit 932872382355f00112641d305ba0619305dc8642
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Derivative
import Mathbin.Tactic.LinearCombination
import Mathbin.Tactic.RingExp

/-!
# Theory of univariate polynomials

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

The main def is `binom_expansion`.
-/

noncomputable section

namespace Polynomial

open Polynomial

universe u v w x y z

variable {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : Type z} {a b : R}
  {m n : ℕ}

section Identities

/- warning: polynomial.pow_add_expansion -> Polynomial.powAddExpansion is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R] (x : R) (y : R) (n : Nat), Subtype.{succ u1} R (fun (k : R) => Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) x y) n) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) x n) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} R (NonAssocSemiring.toAddCommMonoidWithOne.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))))) n) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) x (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) y)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) k (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) y (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R] (x : R) (y : R) (n : Nat), Subtype.{succ u1} R (fun (k : R) => Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) x y) n) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) x n) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (Nat.cast.{u1} R (Semiring.toNatCast.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) n) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) x (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) y)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) k (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) y (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))))
Case conversion may be inaccurate. Consider using '#align polynomial.pow_add_expansion Polynomial.powAddExpansionₓ'. -/
/- @TODO: pow_add_expansion and pow_sub_pow_factor are not specific to polynomials.
  These belong somewhere else. But not in group_power because they depend on tactic.ring_exp

Maybe use data.nat.choose to prove it.
 -/
/-- `(x + y)^n` can be expressed as `x^n + n*x^(n-1)*y + k * y^2` for some `k` in the ring.
-/
def powAddExpansion {R : Type _} [CommSemiring R] (x y : R) :
    ∀ n : ℕ, { k // (x + y) ^ n = x ^ n + n * x ^ (n - 1) * y + k * y ^ 2 }
  | 0 => ⟨0, by simp⟩
  | 1 => ⟨0, by simp⟩
  | n + 2 => by
    cases' pow_add_expansion (n + 1) with z hz
    exists x * z + (n + 1) * x ^ n + z * y
    calc
      (x + y) ^ (n + 2) = (x + y) * (x + y) ^ (n + 1) := by ring
      _ = (x + y) * (x ^ (n + 1) + ↑(n + 1) * x ^ (n + 1 - 1) * y + z * y ^ 2) := by rw [hz]
      _ = x ^ (n + 2) + ↑(n + 2) * x ^ (n + 1) * y + (x * z + (n + 1) * x ^ n + z * y) * y ^ 2 :=
        by
        push_cast
        ring!

#align polynomial.pow_add_expansion Polynomial.powAddExpansion

variable [CommRing R]

private def poly_binom_aux1 (x y : R) (e : ℕ) (a : R) :
    { k : R // a * (x + y) ^ e = a * (x ^ e + e * x ^ (e - 1) * y + k * y ^ 2) } :=
  by
  exists (pow_add_expansion x y e).val
  congr
  apply (pow_add_expansion _ _ _).property
#align polynomial.poly_binom_aux1 polynomial.poly_binom_aux1

private theorem poly_binom_aux2 (f : R[X]) (x y : R) :
    f.eval (x + y) =
      f.Sum fun e a => a * (x ^ e + e * x ^ (e - 1) * y + (polyBinomAux1 x y e a).val * y ^ 2) :=
  by
  unfold eval eval₂; congr with (n z)
  apply (poly_binom_aux1 x y _ _).property
#align polynomial.poly_binom_aux2 polynomial.poly_binom_aux2

private theorem poly_binom_aux3 (f : R[X]) (x y : R) :
    f.eval (x + y) =
      ((f.Sum fun e a => a * x ^ e) + f.Sum fun e a => a * e * x ^ (e - 1) * y) +
        f.Sum fun e a => a * (polyBinomAux1 x y e a).val * y ^ 2 :=
  by
  rw [poly_binom_aux2]
  simp [left_distrib, sum_add, mul_assoc]
#align polynomial.poly_binom_aux3 polynomial.poly_binom_aux3

/- warning: polynomial.binom_expansion -> Polynomial.binomExpansion is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (x : R) (y : R), Subtype.{succ u1} R (fun (k : R) => Eq.{succ u1} R (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) x y) f) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toHasAdd.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x f) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x (coeFn.{succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (fun (_x : LinearMap.{u1, u1, u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) => (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) -> (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (LinearMap.hasCoeToFun.{u1, u1, u1, u1} R R (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Polynomial.derivative.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) f)) y)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) k (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) y (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (x : R) (y : R), Subtype.{succ u1} R (fun (k : R) => Eq.{succ u1} R (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) x y) f) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} R R R (instHAdd.{u1} R (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x f) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x (FunLike.coe.{succ u1, succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (fun (_x : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) => (fun (x._@.Mathlib.Algebra.Module.LinearMap._hyg.6190 : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) => Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) _x) (LinearMap.instFunLikeLinearMap.{u1, u1, u1, u1} R R (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Polynomial.module.{u1, u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Polynomial.derivative.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) f)) y)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) k (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) y (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))))
Case conversion may be inaccurate. Consider using '#align polynomial.binom_expansion Polynomial.binomExpansionₓ'. -/
/-- A polynomial `f` evaluated at `x + y` can be expressed as
the evaluation of `f` at `x`, plus `y` times the (polynomial) derivative of `f` at `x`,
plus some element `k : R` times `y^2`.
-/
def binomExpansion (f : R[X]) (x y : R) :
    { k : R // f.eval (x + y) = f.eval x + f.derivative.eval x * y + k * y ^ 2 } :=
  by
  exists f.sum fun e a => a * (poly_binom_aux1 x y e a).val
  rw [poly_binom_aux3]
  congr
  · rw [← eval_eq_sum]
  · rw [derivative_eval]
    exact finset.sum_mul.symm
  · exact finset.sum_mul.symm
#align polynomial.binom_expansion Polynomial.binomExpansion

/- warning: polynomial.pow_sub_pow_factor -> Polynomial.powSubPowFactor is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (x : R) (y : R) (i : Nat), Subtype.{succ u1} R (fun (z : R) => Eq.{succ u1} R (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) x i) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) y i)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) z (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) x y)))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (x : R) (y : R) (i : Nat), Subtype.{succ u1} R (fun (z : R) => Eq.{succ u1} R (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) x i) (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) y i)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) z (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) x y)))
Case conversion may be inaccurate. Consider using '#align polynomial.pow_sub_pow_factor Polynomial.powSubPowFactorₓ'. -/
/-- `x^n - y^n` can be expressed as `z * (x - y)` for some `z` in the ring.
-/
def powSubPowFactor (x y : R) : ∀ i : ℕ, { z : R // x ^ i - y ^ i = z * (x - y) }
  | 0 => ⟨0, by simp⟩
  | 1 => ⟨1, by simp⟩
  | k + 2 => by
    cases' @pow_sub_pow_factor (k + 1) with z hz
    exists z * x + y ^ (k + 1)
    linear_combination (norm := ring) x * hz
#align polynomial.pow_sub_pow_factor Polynomial.powSubPowFactor

/- warning: polynomial.eval_sub_factor -> Polynomial.evalSubFactor is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (x : R) (y : R), Subtype.{succ u1} R (fun (z : R) => Eq.{succ u1} R (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x f) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) y f)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1)))) z (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (SubNegMonoid.toHasSub.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))))))) x y)))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (x : R) (y : R), Subtype.{succ u1} R (fun (z : R) => Eq.{succ u1} R (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) x f) (Polynomial.eval.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) y f)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) z (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R (Ring.toSub.{u1} R (CommRing.toRing.{u1} R _inst_1))) x y)))
Case conversion may be inaccurate. Consider using '#align polynomial.eval_sub_factor Polynomial.evalSubFactorₓ'. -/
/-- For any polynomial `f`, `f.eval x - f.eval y` can be expressed as `z * (x - y)`
for some `z` in the ring.
-/
def evalSubFactor (f : R[X]) (x y : R) : { z : R // f.eval x - f.eval y = z * (x - y) } :=
  by
  refine' ⟨f.sum fun i r => r * (pow_sub_pow_factor x y i).val, _⟩
  delta eval eval₂
  simp only [Sum, ← Finset.sum_sub_distrib, Finset.sum_mul]
  dsimp
  congr with (i r)
  rw [mul_assoc, ← (pow_sub_pow_factor x y _).Prop, mul_sub]
#align polynomial.eval_sub_factor Polynomial.evalSubFactor

end Identities

end Polynomial


import Mathlib

import Lean
import Aesop
--set_option pp.all true

structure format where
  r : ℤ
  p : ℤ
  e : ℤ

@[aesop unsafe]
def pow_int(r : ℤ) (i : ℤ): ℚ :=
  (r : ℚ) ^ i

@[aesop unsafe]
def real_mul (r : ℝ) (i :ℤ) : ℝ :=
  r * (i : ℝ)

noncomputable instance : HMul ℝ ℤ ℝ where
  hMul := real_mul

instance : HPow ℤ ℤ ℚ where
  hPow := pow_int

open Int
@[simp]
theorem Int.one_lt_zero_lt (i : ℤ) : 1 < i → 0 < i := by
  intro h
  have hz : (0: ℤ) < 1 := by simp
  apply lt_trans hz h
@[simp]
theorem Int.one_lt_zero_le_iff (i : ℤ) (j : ℤ) : j < i ↔ j + 1 ≤ i := by
  apply Iff.intro
  · intro a
    exact a
  · intro a
    exact a
@[simp]
theorem Int.one_lt_ne_one {a : ℤ}(h : 1 < a):a ≠ 1 := by
  intro a_1
  simp_all only [one_lt_zero_le_iff, ne_eq]

@[aesop unsafe]
theorem ipow_lt_zero {r : ℝ}{i : ℤ} : 0 < r → 0 < r ^ i := by
  intro h
  cases i with
  | ofNat n  =>
    -- HACK: aesop
      simp_all only [Int.ofNat_eq_coe, zpow_coe_nat, gt_iff_lt, pow_pos]
  | negSucc n =>
    -- HACK: aesop
      simp_all only [zpow_negSucc, inv_pos, gt_iff_lt, pow_pos]
@[simp]
theorem ipow_inv {r : ℝ}{i : ℕ} : r ^ Int.negOfNat i = Inv.inv (r ^ i) := by
  induction i
  case zero => simp; trivial
  case succ => constructor

@[simp]
theorem ipow_neg_succ {r : ℝ}{i : ℕ} : r ^ Int.negSucc i = Inv.inv (r ^ (Nat.succ i)):= by
  simp_all only [zpow_negSucc]

@[simp]
theorem ipow_inv_neg {r : ℝ}{i : ℤ} : r ≠ 0 → r ^ i = Inv.inv (r ^(-i)) := by
  cases i with
  | ofNat n =>
      -- HACK: aesop
      intros
      simp_all only [ne_eq, Int.ofNat_eq_coe, zpow_coe_nat, zpow_neg, inv_inv]
  | negSucc n =>
      -- HACK: aesop
      intros
      simp_all only [ne_eq, zpow_negSucc, zpow_neg, inv_inv]
@[simp]
theorem ipow_add_exp {r : ℝ} (u : ℤ) (v : ℤ) : r ≠ 0 → r ^ u * r ^ v = r ^ (u + v) := by
  sorry

/-
theorem ipow_eq_exp
theorem ipow_eq_exp_p
-/
/-
@[simp]
theorem ipow_between {x : ℝ}{y z i : ℤ} :
  (0 < x) → (y * x ^ e ≤ z * x ^ e) → (z * x ^ e ≤ (y + 1) * x ^ e)
  → (z = y) ∨ (z = y + 1):= by
    sorry
-/
@[simp]
theorem ipow_to_one {r : ℝ} : r ^ 1 = r := by
  simp

@[simp]
theorem ipow_to_zero {r : ℝ} : r ^ 0 = 1 := by
  simp

@[simp]
theorem ipow_le_one {r : ℝ}{i : ℤ} : 1 ≤ r → 0 ≤ i → 1 ≤ r ^ i := by
  sorry

@[simp]
theorem ipow_lt_one {r : ℝ}{i : ℤ} : 1 < r → 0 < i → 1 < r ^ i := by
  sorry

@[simp]
theorem ipow_le_sum {r : ℝ}{n : ℝ} : 2 ≤ r → 0 ≤ i → ∃(e : ℤ), n ≤ r ^ e := by
  sorry

@[simp]
theorem ipow_le_real {r : ℝ}{z : ℝ} : 2 ≤ r → ∃ (e : ℤ) , z ≤ r ^ e := by
  --TODO: finding the bound using log is impossible because log isn't defined yet in mathlib4 for real numbers
  sorry

@[simp]
theorem ipow_le_real_two {r : ℝ}{z : ℝ} : 0 < z → 2 ≤ r → ∃ e : ℤ , r ^ e ≤ z := by
  sorry

@[simp]
theorem ipow_monotone {r : ℝ}{u : ℤ}{v : ℤ} : 1 ≤ r → u ≤ v → r ^ u ≤ r ^ v := by
  sorry

@[simp]
theorem ipow_monotone_lt {r :ℝ}{u : ℤ}{v :ℤ} : 1 < r → u < v →  r ^ u < r ^ v := by
  mono
  intro a a_1
  simp_all only [ne_eq, gt_iff_lt, zpow_lt_iff_lt]
@[simp]
theorem ipow_monotone_two {r : ℝ}{u : ℤ}{v : ℤ} : 2 ≤ r → u ≤ v → r ^ u ≤ r ^ v  := by
  sorry

@[simp]
theorem ipow_mul_inv_eq_one {r : ℝ}{i : ℤ} : 0 < r → r ^ i * r ^ (-i) = 1 := by
  sorry

noncomputable def rerror (a : ℝ)(b : ℝ): ℝ :=
  |((b - a) / a)|

def closer (x y z : ℝ): Prop :=
  abs (x - z) < abs (y - z)

-- sup inf definitions
--
@[aesop unsafe]
def is_sup_int (s : Int → Prop)(e : Int): Prop :=
  IsLUB s e
@[aesop unsafe]
def is_sup_real ( s : ℝ → Prop)(r : ℝ) : Prop :=
  IsGLB s r

open Classical

@[aesop unsafe]
noncomputable def sup_num (s : ℝ → Prop) : ℝ :=
  Classical.epsilon (is_sup_real s)

@[aesop unsafe]
noncomputable def sup_int (s : ℤ → Prop) : ℤ :=
  Classical.epsilon (is_sup_int s)


import .semantics

open nnf subtype list

def pmark (Γ m : list nnf) := ∀ Δ, (∀ δ ∈ Δ, δ ∉ m) → Δ <+ Γ → unsatisfiable (list.diff Γ Δ)

@[simp] def mark_and : nnf → list nnf → list nnf
| (nnf.and φ ψ) m := if φ ∈ m ∨ ψ ∈ m then nnf.and φ ψ :: m else
                     m
| _ m := m

@[simp] def mark_or : nnf → list nnf → list nnf → list nnf
| (nnf.or φ ψ) ml mr:= if φ ∈ ml ∨ ψ ∈ mr then nnf.or φ ψ :: (ml++mr) else ml ++ mr
| _ ml mr := ml ++ mr

@[simp] def mark_modal (Γ i m : list nnf) : list nnf :=
dia i.head :: rebox (i.tail ∩ m)

namespace list
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

theorem mem_tail_of_ne_head [inhabited α] {a : α} : Π {l : list α}, a ∈ l → a ≠ l.head → a ∈ l.tail
| [] h₁ h₂ := absurd h₁ $ not_mem_nil _
| (hd::tl) h₁ h₂ := by cases h₁; {simpa}

end list

theorem box_mem_of_mark_modal {φ} (Γ i m : list nnf) (h₁ : φ ∈ m) (h₂ : φ ∈ i) :
φ = i.head ∨ box φ ∈ mark_modal Γ i m :=
begin
simp,
by_cases h : φ = i.head,
{left, exact h},
{right, rw rebox_iff, simp, split,
 {apply list.mem_tail_of_ne_head h₂ h},
 {exact h₁} }
end

theorem subset_mark_and {φ Γ} : Γ ⊆ mark_and φ Γ :=
begin
cases heq : φ,
case nnf.and : ψ₁ ψ₂
{ dsimp,
  by_cases ψ₁ ∈ Γ ∨ ψ₂ ∈ Γ,
  {rw if_pos h, simp},
  {rw if_neg h, simp} },
all_goals {simp}
end

theorem unsat_mark_and {φ Γ} (h : unsatisfiable Γ) :
unsatisfiable (mark_and φ Γ) :=
begin apply unsat_subset, apply subset_mark_and, exact h end

theorem subset_mark_or_left {φ Γ₁ Γ₂} : Γ₁ ⊆ mark_or φ Γ₁ Γ₂:=
begin
cases heq : φ,
case nnf.or : ψ₁ ψ₂
{ dsimp,
  by_cases ψ₁ ∈ Γ₁ ∨ ψ₂ ∈ Γ₂,
  {rw if_pos h, rw ←cons_append,
   apply subset_append_of_subset_left, simp},
  {rw if_neg h, simp} },
all_goals {simp}
end

theorem subset_mark_or_right {φ Γ₁ Γ₂} : Γ₂ ⊆ mark_or φ Γ₁ Γ₂:=
begin
cases heq : φ,
case nnf.or : ψ₁ ψ₂
{ dsimp,
  by_cases ψ₁ ∈ Γ₁ ∨ ψ₂ ∈ Γ₂,
  {rw if_pos h, rw ←cons_append,
   apply subset_append_of_subset_right, simp},
  {rw if_neg h, simp} },
all_goals {simp}
end

theorem unsat_mark_or_left {φ Γ₁ Γ₂} (h : unsatisfiable Γ₁) :
unsatisfiable (mark_or φ Γ₁ Γ₂) :=
begin apply unsat_subset, apply subset_mark_or_left, exact h end

theorem unsat_mark_or_right {φ Γ₁ Γ₂} (h : unsatisfiable Γ₂) :
unsatisfiable (mark_or φ Γ₁ Γ₂) :=
begin apply unsat_subset, apply subset_mark_or_right, exact h end

def pmark_of_closed_and {Γ Δ} (i : and_instance Γ Δ) (m) (h : unsatisfiable Δ) (p : pmark Δ m) : {x // pmark Γ x} :=
begin
  cases i with φ ψ hin, split, swap,
  {exact mark_and (and φ ψ) m},
  { intros Δ' hΔ hsub,
    by_cases hm : φ ∈ m ∨ ψ ∈ m,
   -- pos hm
    { cases hm,
      -- left hm
      { have marked : nnf.and φ ψ ∈ mark_and (nnf.and φ ψ) m,
          {simp [mem_cons_self, hm] },
        have : unsatisfiable (list.diff (φ :: ψ :: list.erase Γ (and φ ψ)) Δ'),
          {apply p,
           {intros δ hδ hmem, apply hΔ _ hδ, apply subset_mark_and hmem},
           have : Δ'.erase (and φ ψ) <+ φ :: ψ :: list.erase Γ (and φ ψ),
             {apply sublist.cons, apply sublist.cons, apply sublist.erase _ hsub},
           have hnin: and φ ψ ∉ Δ',
             {intro, apply hΔ _ a marked},
           rw ←erase_of_not_mem hnin, exact this},
        intro, intros, intro hsat,
        have hsat : sat k s (list.diff (φ :: ψ :: list.erase Γ (and φ ψ)) Δ'),
          {apply sat_subset _ (φ :: (ψ :: list.erase Γ (and φ ψ)).diff Δ'),
           apply subset_cons_diff, apply sat_subset _ (φ :: ψ :: (list.erase Γ (and φ ψ)).diff Δ'), apply cons_subset_cons, apply subset_cons_diff,
           have hsatp : and φ ψ ∈ Γ.diff Δ',
             {apply mem_diff_of_mem hin, intro, apply hΔ _ a marked},
           intros x hx, rcases hx with eq₁ | eq₂ | hin',
           rw eq₁, apply and.left, rw ←sat_of_and, apply hsat _ hsatp,
           rw eq₂, apply and.right, rw ←sat_of_and, apply hsat _ hsatp,
           have hsubd : list.diff (list.erase Γ (and φ ψ)) Δ' ⊆ list.diff Γ Δ',
             {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
           apply hsat, apply hsubd, exact hin'},
        apply this, exact hsat },
      -- right hm
      { have marked : nnf.and φ ψ ∈ mark_and (nnf.and φ ψ) m,
         { simp [mem_cons_self, hm] },
        have : unsatisfiable (list.diff (φ :: ψ :: list.erase Γ (and φ ψ)) Δ'),
          {apply p,
           {intros δ hδ hmem, apply hΔ _ hδ, apply subset_mark_and hmem},
          have : Δ'.erase (and φ ψ) <+ φ :: ψ :: list.erase Γ (and φ ψ),
            {apply sublist.cons, apply sublist.cons, apply sublist.erase, exact hsub},
          have hnin: and φ ψ ∉ Δ',
            {intro, apply hΔ _ a marked},
          rw ←erase_of_not_mem hnin, exact this},
        intro, intros, intro hsat,
        have hsat : sat k s (list.diff (φ :: ψ :: list.erase Γ (and φ ψ)) Δ'),
          {apply sat_subset _ (φ :: (ψ :: list.erase Γ (and φ ψ)).diff Δ'),
           apply subset_cons_diff, apply sat_subset _ (φ :: ψ :: (list.erase Γ (and φ ψ)).diff Δ'), apply cons_subset_cons, apply subset_cons_diff,
           have hsatp : and φ ψ ∈ Γ.diff Δ',
             {apply mem_diff_of_mem hin, intro, apply hΔ _ a marked},
           intros x hx, rcases hx with eq₁ | eq₂ | hin',
           rw eq₁, apply and.left, rw ←sat_of_and, apply hsat _ hsatp,
           rw eq₂, apply and.right, rw ←sat_of_and, apply hsat _ hsatp,
           have hsubd : list.diff (list.erase Γ (and φ ψ)) Δ' ⊆ list.diff Γ Δ',
             {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
           apply hsat, apply hsubd, exact hin'},
        apply this, exact hsat } },
  -- neg hm
   { have : unsatisfiable ((φ :: ψ :: list.erase Γ (and φ ψ)).diff $ φ :: ψ :: Δ'.erase (and φ ψ)),
       {apply p, intros δ hδ hdin, rcases hδ with eq₁ | eq₂ | hmem,
         {apply hm, left, rw ←eq₁, exact hdin},
         {apply hm, right, rw ←eq₂, exact hdin},
         {apply hΔ, apply erase_subset _ _ hmem, apply subset_mark_and hdin},
        apply sublist.cons2, apply sublist.cons2, apply sublist.erase _ hsub },
     intro, intros, intro hsat, apply this, simp,
     apply sat_sublist, apply erase_diff_erase_sublist_of_sublist hsub, exact hsat } }
end

theorem unsat_of_jump {Γ₁ Γ₂ Δ : list nnf} (i : or_instance Δ Γ₁ Γ₂)
(m : list nnf) (h₁ : unsatisfiable Γ₁) (h₂ : pmark Γ₁ m)
(h₃ : left_prcp i ∉ m) : unsatisfiable Δ :=
begin
  cases i with φ ψ hin,
  have : unsatisfiable ((φ :: list.erase Δ (or φ ψ)).diff [φ]),
    {apply h₂, intros, cases H, rw H, exact h₃, intro, exact not_mem_nil δ H, apply sublist.cons2, simp},
  intro, intros, intro hsat, apply this,
  apply sat_subset _ Δ _ _ _ hsat, simp [erase_subset]
end

def pmark_of_jump {Γ₁ Γ₂ Δ : list nnf} (i : or_instance Δ Γ₁ Γ₂)
(m : list nnf) (h₁ : unsatisfiable Γ₁) (h₂ : pmark Γ₁ m)
(h₃ : left_prcp i ∉ m) : {x // pmark Δ x} :=
begin
  cases i with φ ψ hin,
  split, swap, {exact mark_or (or φ ψ) m []},
  { intros Δ' hΔ' hsub,
    have : unsatisfiable (list.diff (φ :: Δ.erase (or φ ψ)) (φ :: Δ'.erase (or φ ψ))),
      { apply h₂, intros, intro hmem, rcases H with eq | hin,
        {apply h₃, simpa [eq] using hmem},
        {apply hΔ' δ, apply erase_subset _ _ hin, apply subset_mark_or_left hmem},
      apply sublist.cons2, apply sublist.erase _ hsub },
    intro, intros, intro hsat,
    apply this st k s, simp, apply sat_sublist, apply erase_diff_erase_sublist_of_sublist, exact hsub, exact hsat }
end

def pmark_of_closed_or {Γ₁ Γ₂ Δ : list nnf} {m₁ m₂ : list nnf} (i : or_instance Δ Γ₁ Γ₂) (h₁ : unsatisfiable Γ₁) (p₁ : pmark Γ₁ m₁)
(h₂ : unsatisfiable Γ₂) (p₂ : pmark Γ₂ m₂) : {x // pmark Δ x} :=
begin
  cases i with φ ψ hin, split, swap,
  {exact mark_or (or φ ψ) m₁ m₂},
  {intros Δ' hΔ hsub,
    by_cases hmφ : φ ∈ m₁,
    { have marked : or φ ψ ∈ mark_or (or φ ψ) m₁ m₂,
        {simp [hmφ]},
      have hnin: or φ ψ ∉ Δ',
        {intro, apply hΔ _ a marked},
      have hl : unsatisfiable (list.diff (φ :: list.erase Δ (or φ ψ)) Δ'),
        {apply p₁,
        {intros δ hδ hin, apply hΔ, exact hδ, apply subset_mark_or_left, exact hin},
        have : Δ'.erase (or φ ψ) <+ φ :: list.erase Δ (or φ ψ),
          {apply sublist.cons, apply sublist.erase, exact hsub},
        rw ←erase_of_not_mem hnin, exact this},
      have hr : unsatisfiable (list.diff (ψ :: list.erase Δ (or φ ψ)) Δ'),
        {apply p₂,
        {intros δ hδ hin, apply hΔ, exact hδ, apply subset_mark_or_right, exact hin},
        have : Δ'.erase (or φ ψ) <+ ψ :: list.erase Δ (or φ ψ),
          {apply sublist.cons, apply sublist.erase, exact hsub},
        rw ←erase_of_not_mem hnin, exact this},
      intro, intros, intro hsat,
      have : or φ ψ ∈ list.diff Δ Δ',
        {apply mem_diff_of_mem hin hnin},
      have hforce := hsat _ this, dsimp at hforce,
      cases hforce with l r,
      { apply hl st k s,
        apply sat_subset,
        apply subperm.subset,
        apply subperm_cons_diff,
        intros x hx,
        cases hx, rw hx, exact l, apply hsat,
        have hsubd : list.diff (list.erase Δ (or φ ψ)) Δ' ⊆ list.diff Δ Δ',
          {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
        apply hsubd hx },
      { apply hr st k s,
        apply sat_subset,
        apply subperm.subset,
        apply subperm_cons_diff,
        intros x hx,
        cases hx, rw hx, exact r, apply hsat,
        have hsubd : list.diff (list.erase Δ (or φ ψ)) Δ' ⊆ list.diff Δ Δ',
          {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
        apply hsubd hx } },
{by_cases hmψ : ψ ∈ m₂,
 -- marked ψ
 { have marked : or φ ψ ∈ mark_or (or φ ψ) m₁ m₂,
     {simp [hmψ]},
   have hnin: or φ ψ ∉ Δ',
     {intro, apply hΔ _ a marked},
   have hl : unsatisfiable (list.diff (φ :: list.erase Δ (or φ ψ)) Δ'),
     {apply p₁,
     {intros δ hδ hin, apply hΔ, exact hδ, apply subset_mark_or_left, exact hin},
     have : Δ'.erase (or φ ψ) <+ φ :: list.erase Δ (or φ ψ),
       {apply sublist.cons, apply sublist.erase, exact hsub},
     rw ←erase_of_not_mem hnin, exact this},
   have hr : unsatisfiable (list.diff (ψ :: list.erase Δ (or φ ψ)) Δ'),
     {apply p₂,
     {intros δ hδ hin, apply hΔ, exact hδ, apply subset_mark_or_right, exact hin},
     have : Δ'.erase (or φ ψ) <+ ψ :: list.erase Δ (or φ ψ),
       {apply sublist.cons, apply sublist.erase, exact hsub},
     rw ←erase_of_not_mem hnin, exact this},
   intro, intros, intro hsat,
   have : or φ ψ ∈ list.diff Δ Δ',
     {apply mem_diff_of_mem hin hnin},
   have hforce := hsat _ this, dsimp at hforce,
   cases hforce with l r,
   { apply hl st k s,
     apply sat_subset,
     apply subperm.subset,
     apply subperm_cons_diff,
     intros x hx,
     cases hx, rw hx, exact l, apply hsat,
     have hsubd : list.diff (list.erase Δ (or φ ψ)) Δ' ⊆ list.diff Δ Δ',
       {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
     apply hsubd hx },
   { apply hr st k s,
     apply sat_subset,
     apply subperm.subset,
     apply subperm_cons_diff,
     intros x hx,
     cases hx, rw hx, exact r, apply hsat,
     have hsubd : list.diff (list.erase Δ (or φ ψ)) Δ' ⊆ list.diff Δ Δ',
       {apply sublist.subset, apply sublist.diff_right, apply erase_sublist},
     apply hsubd hx } },
-- both unmarked
 { have : unsatisfiable (list.diff (φ :: Δ.erase (or φ ψ)) (φ :: Δ'.erase (or φ ψ))),
     {apply p₁, intros, intro hmem, rcases H with eq | hin,
      {apply hmφ, rw ←eq, exact hmem},
      {apply hΔ δ, apply erase_subset _ _ hin, apply subset_mark_or_left, exact hmem},
      apply sublist.cons2, apply sublist.erase _ hsub},
   intro, intros, intro hsat,
   apply this st k s, simp, apply sat_sublist,
   apply erase_diff_erase_sublist_of_sublist hsub, exact hsat } } }
end

def unbox_sublist_of_unmodal (Γ : list nnf) : ∀ (i : list nnf),  i ∈ unmodal Γ → (∀ Δ, Δ <+ Γ → unbox Δ <+ i) :=
list.mapp _ _
begin
intros φ h Δ hΔ,
apply sublist_cons_of_sublist,
apply unbox_sublist hΔ
end

theorem modal_pmark {Γ} (h₁ : modal_applicable Γ) (i m)
(h₂ : i ∈ unmodal Γ ∧ unsatisfiable i)
(h₃ : pmark i m) : pmark Γ (mark_modal Γ i m) :=
begin
  intro, intros hδ hsub, intro, intros, intro hsat,
  let B' := filter (≠ i.head) (unbox Δ),
  have hsubB' : B' <+ i,
    {apply sublist.trans, swap 3, exact unbox Δ, apply filter_sublist, apply unbox_sublist_of_unmodal _ _ h₂.1 _ hsub},
  have hB' : ∀ x, x ∈ B' → x ∉ m,
    {intros x hx hin,
     have hxi : x ∈ i, { exact sublist.subset hsubB' hx },
     have := box_mem_of_mark_modal _ _ _ hin hxi,
     swap, {exact Γ},
     cases this,
     {rw [mem_filter] at hx, have := hx.2, contradiction},
     {apply hδ, swap, exact this, rw unbox_iff, rw [mem_filter] at hx, exact hx.1} },
  have hunsat := h₃ B' hB' hsubB',
  have hhead : dia i.head ∉ Δ,
    {intro hmem, apply hδ, exact hmem, simp},
  have := unmodal_jump _ _ h₂.1 _ _ _ _ hsat hhead,
  rcases this with ⟨w, hw⟩,
  apply hunsat, exact hw,
end


-- Copyright (c) 2018 Michael Jendrusch. All rights reserved.

import category_theory.category
import category_theory.functor
import category_theory.products
import category_theory.natural_isomorphism
import .tensor_product
import .monoidal_category
import tactic.rewrite_search
import tactic.interactive

open category_theory
open tactic

universe u

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

open category_theory.category
open category_theory.functor
open category_theory.prod
open category_theory.functor.category.nat_trans
open category_theory.nat_iso

namespace category_theory.monoidal

section

open monoidal_category

structure monoidal_functor
  (C : Sort u₁) [𝒞 : monoidal_category.{v₁} C]
  (D : Sort u₂) [𝒟 : monoidal_category.{v₂} D]
extends category_theory.functor C D :=
-- unit morphism
(ε               : tensor_unit D ≅ obj (tensor_unit C))
-- natural transformation
(μ                : Π X Y : C, (obj X) ⊗ (obj Y) ≅ obj (X ⊗ Y))
(μ_natural'       : ∀ (X Y X' Y' : C)
  (f : X ⟶ Y) (g : X' ⟶ Y'),
  (μ X X').hom ≫ map (f ⊗ g) = ((map f) ⊗ (map g)) ≫ (μ Y Y').hom
  . obviously)
-- associativity
(associativity'   : ∀ (X Y Z : C),
    ((μ X Y).hom ⊗ 𝟙 (obj Z)) ≫ (μ (X ⊗ Y) Z).hom ≫ map (associator X Y Z).hom
  = (associator (obj X) (obj Y) (obj Z)).hom ≫ (𝟙 (obj X) ⊗ (μ Y Z).hom) ≫ (μ X (Y ⊗ Z)).hom
  . obviously)
-- unitality
(left_unitality'  : ∀ X : C,
    (left_unitor (obj X)).hom
  = (ε.hom ⊗ 𝟙 (obj X)) ≫ (μ (tensor_unit C) X).hom ≫ map (left_unitor X).hom
  . obviously)
(right_unitality' : ∀ X : C,
    (right_unitor (obj X)).hom
  = (𝟙 (obj X) ⊗ ε.hom) ≫ (μ X (tensor_unit C)).hom ≫ map (right_unitor X).hom
  . obviously)

restate_axiom monoidal_functor.μ_natural'
attribute [simp,search] monoidal_functor.μ_natural
restate_axiom monoidal_functor.left_unitality'
attribute [simp,search] monoidal_functor.left_unitality
restate_axiom monoidal_functor.right_unitality'
attribute [simp,search] monoidal_functor.right_unitality
restate_axiom monoidal_functor.associativity'
attribute [simp,search] monoidal_functor.associativity

end

namespace monoidal_functor
variables {C : Sort u₁} [𝒞 : monoidal_category.{v₁} C]
variables {D : Sort u₂} [𝒟 : monoidal_category.{v₂} D]
include 𝒞 𝒟

-- This is unfortunate; we need all sorts of struts to give
-- monoidal functors the features of functors...
@[reducible] def on_iso (F : monoidal_functor C D) {X Y : C} (f : X ≅ Y) : F.obj X ≅ F.obj Y :=
F.to_functor.map_iso f

@[search] lemma map_id (F : monoidal_functor C D) (X : C) :
  F.map (𝟙 X) = 𝟙 (F.obj X) := F.map_id' X

@[search] lemma map_comp (F : monoidal_functor C D) {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  F.map (f ≫ g) = F.map f ≫ F.map g := F.map_comp' f g

end monoidal_functor

section

variables (C : Sort u₁) [𝒞 : monoidal_category.{v₁} C]
variables (D : Sort u₂) [𝒟 : monoidal_category.{v₂} D]
variables (E : Sort u₃) [ℰ : monoidal_category.{v₃} E]

include 𝒞 𝒟 ℰ

open tactic.rewrite_search.tracer
-- set_option profiler true

def monoidal_functor.comp
  (F : monoidal_functor C D) (G : monoidal_functor D E) : monoidal_functor C E :=
{ ε                := G.ε ≪≫ (G.on_iso F.ε),
  μ                := λ X Y, G.μ (F.obj X) (F.obj Y) ≪≫ G.on_iso (F.μ X Y),
  μ_natural'       :=
  begin
    tidy,
    /- `rewrite_search` says -/ -- FIXME actually, its output is broken
    conv_lhs { congr, skip, erw [←map_comp] },
    conv_lhs { erw [monoidal_functor.μ_natural] },
    conv_lhs { congr, skip, erw [map_comp] },
    conv_lhs { erw [←category.assoc] },
    conv_lhs { congr, erw [monoidal_functor.μ_natural] },
    conv_rhs { erw [←category.assoc] },
  end,
  associativity'   := λ X Y Z,
  begin
    -- obviously fails here, but it seems like it should be doable!
    dsimp,
    conv { to_rhs,
      rw ←interchange_right_identity,
      slice 3 4,
      rw ← G.map_id,
      rw ← G.μ_natural,
    },
    -- rewrite_search { view := visualiser, trace_summary := tt, explain := tt, max_iterations := 50 }, -- fails
    conv { to_rhs,
      slice 1 3,
      rw ←G.associativity,
    },
    -- rewrite_search (saw/visited/used) 137/23/16 expressions during proof of category_theory.monoidal.monoidal_functor.comp
    conv { to_lhs,
      rw ←interchange_left_identity,
      slice 2 3,
      rw ← G.map_id,
      rw ← G.μ_natural, },
    repeat { rw category.assoc },
    repeat { rw ←G.map_comp },
    rw F.associativity,
  end,
  left_unitality'  := λ X,
  begin
    -- Don't attempt to read this; it is a Frankenstein effort of Scott + rewrite_search
    dsimp,
    rw G.left_unitality,
    rw ←interchange_left_identity,
    repeat {rw category.assoc},
    apply congr_arg,
    /- `rewrite_search` says -/ -- FIXME actually, its output is broken
    rw F.left_unitality,
    conv_lhs { congr, skip, erw [map_comp] },
    conv_lhs { erw [←category.id_app] },
    conv_lhs { erw [←category.assoc] },
    conv_lhs { congr, erw [monoidal_functor.μ_natural] },
    conv_lhs { congr, congr, congr, skip, erw [map_id] },
    conv_rhs { erw [←category.assoc] },
    erw map_comp,
  end,
  right_unitality' := λ X,
  begin
    dsimp,
    rw G.right_unitality,
    rw ←interchange_right_identity,
    repeat {rw category.assoc},
    apply congr_arg,
    /- `rewrite_search` says -/ -- FIXME actually, its output is broken
    rw F.right_unitality,
    conv_lhs { congr, skip, erw [map_comp] },
    conv_lhs { erw [←category.id_app] },
    conv_lhs { erw [←category.assoc] },
    conv_lhs { congr, erw [monoidal_functor.μ_natural] },
    conv_lhs { congr, congr, congr, erw [map_id] },
    conv_rhs { erw [←category.assoc] },
    erw map_comp,
  end,
  .. (F.to_functor) ⋙ (G.to_functor) }

end

end category_theory.monoidal


import pseudo_normed_group.category
import rescale.basic

noncomputable theory

open_locale nnreal

namespace rescale

open pseudo_normed_group

variables (r r' : ℝ≥0) (M : Type*)

section pseudo_normed_group

variables [pseudo_normed_group M]

instance : pseudo_normed_group (rescale r M) :=
{ filtration := λ c, show set M, from filtration M (c * r⁻¹),
  filtration_mono := λ c₁ c₂ h, filtration_mono (mul_le_mul' h le_rfl),
  zero_mem_filtration := λ c, @zero_mem_filtration M _ _,
  neg_mem_filtration := λ c, @neg_mem_filtration M _ _,
  add_mem_filtration := λ c₁ c₂, by { simp only [add_mul], apply add_mem_filtration } }

lemma mem_filtration (x : rescale r M) (c : ℝ≥0) :
  x ∈ filtration (rescale r M) c ↔ (of.symm x) ∈ filtration M (c * r⁻¹) :=
iff.rfl

lemma mem_filtration' (x : rescale r M) (c : ℝ≥0) [fact (0 < r)] :
of x ∈ filtration (rescale r M) c ↔ x ∈ filtration M (c * r⁻¹) := iff.rfl

def to_rescale_one_strict_pseudo_normed_group_hom :
strict_pseudo_normed_group_hom M (rescale 1 M) :=
{ to_fun := rescale.of,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ c x hx, by rwa [mem_filtration', inv_one, mul_one]
}

def of_rescale_one_strict_pseudo_normed_group_hom :
strict_pseudo_normed_group_hom (rescale 1 M) M :=
{ to_fun := rescale.of.symm,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ c x hx, by rwa [mem_filtration, inv_one, mul_one] at hx
}

-- def of_to_rescale_one_comp_eq_id [fact (0 < r)] [fact (0 < r')] :
--   (of_rescale_one_strict_pseudo_normed_group_hom M).comp
--   (to_rescale_one_strict_pseudo_normed_group_hom M) =
--   strict_pseudo_normed_group_hom.id (rescale 1 M) :=
-- rfl

-- def to_of_rescale_one_comp_eq_id [fact (0 < r)] [fact (0 < r')] :
--   (to_rescale_one_strict_pseudo_normed_group_hom M).comp
--   (of_rescale_one_strict_pseudo_normed_group_hom M) =
--   strict_pseudo_normed_group_hom.id M :=
-- rfl

def of_rescale_eq_strict_pseudo_normed_group_hom [fact (0 < r)] [fact (0 < r')] (h : r = r') :
strict_pseudo_normed_group_hom (rescale r M) (rescale r' M) :=
{ to_fun := λ m, rescale.of (rescale.of.symm m),
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ c x hx, by rwa [mem_filtration', ← h, ← mem_filtration r M],
}

def of_rescale_rescale_strict_pseudo_normed_group_hom [fact (0 < r)] [fact (0 < r')] :
strict_pseudo_normed_group_hom (rescale r (rescale r' M)) (rescale (r' * r) M) :=
{ to_fun := λ m, (rescale.of (rescale.of.symm (rescale.of.symm m))),
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ c x hx, by rwa [mem_filtration', mul_inv_rev, ← mul_assoc],
}

def to_rescale_rescale_strict_pseudo_normed_group_hom [fact (0 < r)] [fact (0 < r')]:
strict_pseudo_normed_group_hom (rescale (r' * r) M) (rescale r (rescale r' M)) :=
{ to_fun := λ m, (rescale.of (rescale.of (rescale.of.symm m))),
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ c x hx, by
    rwa [mem_filtration' r (rescale r' M), mem_filtration', mul_assoc, ← mul_inv_rev,
      ← mem_filtration (r' * r) M] }

-- def of_to_rescale_rescale_comp_eq_id [fact (0 < r)] [fact (0 < r')] :
--   (of_rescale_rescale_strict_pseudo_normed_group_hom r r' M).comp
--   (to_rescale_rescale_strict_pseudo_normed_group_hom r r' M) =
--   strict_pseudo_normed_group_hom.id (rescale r (rescale r' M)) :=
-- rfl

-- def to_of_rescale_rescale_comp_eq_id' [fact (0 < r)] [fact (0 < r')] :
--   (to_rescale_rescale_strict_pseudo_normed_group_hom r r' M).comp
--   (of_rescale_rescale_strict_pseudo_normed_group_hom r r' M) =
--   strict_pseudo_normed_group_hom.id (rescale (r' * r) M) :=
-- rfl

end pseudo_normed_group

--Should we change name to this section? But one for the comphaus_fil.. and one for the
--profinitely_filt.. seems a lot
section profinitely_filtered_pseudo_normed_group

open comphaus_filtered_pseudo_normed_group profinitely_filtered_pseudo_normed_group

instance [comphaus_filtered_pseudo_normed_group M] :
  comphaus_filtered_pseudo_normed_group (rescale r M) :=
{ topology := by { delta rescale, apply_instance },
  t2 := by { delta rescale, apply_instance },
  compact := by { delta rescale, apply_instance },
  continuous_add' :=
  begin
    intros c₁ c₂,
    haveI : fact ((c₁ + c₂) * r⁻¹ ≤ c₁ * r⁻¹ + c₂ * r⁻¹) := ⟨(add_mul _ _ _).le⟩,
    rw (embedding_cast_le ((c₁ + c₂) * r⁻¹) (c₁ * r⁻¹ + c₂ * r⁻¹)).continuous_iff,
    exact (continuous_add' (c₁ * r⁻¹) (c₂ * r⁻¹)),
  end,
  continuous_neg' := λ c, continuous_neg' _,
  continuous_cast_le := λ c₁ c₂ h, by exactI continuous_cast_le _ _,}

instance [profinitely_filtered_pseudo_normed_group M] :
  profinitely_filtered_pseudo_normed_group (rescale r M) := {}

@[simps]
def map_comphaus_filtered_pseudo_normed_group_hom {M₁ M₂ : Type*}
  [comphaus_filtered_pseudo_normed_group M₁] [comphaus_filtered_pseudo_normed_group M₂]
  (N : ℝ≥0) (f : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  comphaus_filtered_pseudo_normed_group_hom (rescale N M₁) (rescale N M₂) :=
{ to_fun := rescale.of ∘ f ∘ rescale.of.symm,
  map_zero' := f.map_zero,
  map_add' := λ x y, f.map_add x y,
  bound' := begin
    obtain ⟨C, hC⟩ := f.bound,
    refine ⟨C, λ c x hx, _⟩,
    rw rescale.mem_filtration at hx ⊢,
    simp only [function.comp_app, equiv.symm_apply_apply, mul_assoc],
    exact hC hx,
  end,
  continuous' := λ c₁ c₂ f₀ hf₀, f.continuous f₀ hf₀, }

@[simps]
def map_strict_comphaus_filtered_pseudo_normed_group_hom {M₁ M₂ : Type*}
  [comphaus_filtered_pseudo_normed_group M₁] [comphaus_filtered_pseudo_normed_group M₂]
  (N : ℝ≥0) (f : strict_comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  strict_comphaus_filtered_pseudo_normed_group_hom (rescale N M₁) (rescale N M₂) :=
{ to_fun := rescale.of ∘ f ∘ rescale.of.symm,
  map_zero' := f.map_zero,
  map_add' := λ x y, f.map_add x y,
  strict' := λ c x hx, begin
    rw rescale.mem_filtration at hx ⊢,
    simp only [function.comp_app, equiv.symm_apply_apply, mul_assoc],
    exact f.strict hx,
  end,
  continuous' := λ c, f.continuous' _, }

end profinitely_filtered_pseudo_normed_group

section profinitely_filtered_pseudo_normed_group_with_Tinv

open profinitely_filtered_pseudo_normed_group_with_Tinv
open profinitely_filtered_pseudo_normed_group

variables [profinitely_filtered_pseudo_normed_group_with_Tinv r' M]

include r'

@[simps]
def Tinv' : rescale r M →+ rescale r M :=
{ to_fun := λ x, of $ Tinv $ of.symm x,
  map_zero' := by { delta rescale, exact Tinv.map_zero },
  map_add' := by { delta rescale, exact Tinv.map_add } }

lemma Tinv'_mem_filtration (c : ℝ≥0) (x : rescale r M) (hx : x ∈ filtration (rescale r M) c) :
  (Tinv' r r' M) x ∈ filtration (rescale r M) (r'⁻¹ * c) :=
by simpa only [mem_filtration, Tinv'_apply, equiv.symm_apply_apply, mul_assoc]
  using Tinv_mem_filtration _ _ hx

variable [fact (0 < r')]

@[simps]
def Tinv : comphaus_filtered_pseudo_normed_group_hom (rescale r M) (rescale r M) :=
comphaus_filtered_pseudo_normed_group_hom.mk' (Tinv' r r' M)
begin
  refine ⟨r'⁻¹, λ c, ⟨Tinv'_mem_filtration r r' M c, _⟩⟩,
  haveI :  fact (c * r⁻¹ ≤ r' * (r'⁻¹ * c * r⁻¹)) :=
    ⟨by rw [mul_assoc, mul_inv_cancel_left₀ ‹fact (0 < r')›.1.ne.symm]⟩,
  apply Tinv₀_continuous,
end

instance : profinitely_filtered_pseudo_normed_group_with_Tinv r' (rescale r M) :=
{ Tinv := rescale.Tinv r r' M,
  Tinv_mem_filtration := Tinv'_mem_filtration r r' M,
  .. rescale.profinitely_filtered_pseudo_normed_group r M }

@[simps]
def map_comphaus_filtered_pseudo_normed_group_with_Tinv_hom {M₁ M₂ : Type*}
  [profinitely_filtered_pseudo_normed_group_with_Tinv r' M₁]
  [profinitely_filtered_pseudo_normed_group_with_Tinv r' M₂]
  (N : ℝ≥0) (f : comphaus_filtered_pseudo_normed_group_with_Tinv_hom r' M₁ M₂) :
  comphaus_filtered_pseudo_normed_group_with_Tinv_hom r' (rescale N M₁) (rescale N M₂) :=
{ to_fun := rescale.of ∘ f ∘ rescale.of.symm,
  strict' := λ c x hx, begin
    rw rescale.mem_filtration at hx ⊢,
    simp only [function.comp_app, equiv.symm_apply_apply, mul_assoc],
    exact f.strict hx,
  end,
  map_Tinv' := f.map_Tinv,
  continuous' := λ c, f.continuous' (c * N⁻¹),
  .. map_comphaus_filtered_pseudo_normed_group_hom N
      f.to_comphaus_filtered_pseudo_normed_group_hom }

end profinitely_filtered_pseudo_normed_group_with_Tinv

end rescale

namespace ProFiltPseuNormGrpWithTinv

variables (r' : ℝ≥0) [fact (0 < r')]

@[simps]
def rescale (N : ℝ≥0) : ProFiltPseuNormGrpWithTinv r' ⥤ ProFiltPseuNormGrpWithTinv r' :=
{ obj := λ M, of r' $ rescale N M,
  map := λ M₁ M₂ f, rescale.map_comphaus_filtered_pseudo_normed_group_with_Tinv_hom _ _ f }

end ProFiltPseuNormGrpWithTinv

namespace ProFiltPseuNormGrpWithTinv₁

variables (r' : ℝ≥0) [fact (0 < r')]

@[simps]
def rescale (N : ℝ≥0) [fact (0 < N)] :
  ProFiltPseuNormGrpWithTinv₁ r' ⥤ ProFiltPseuNormGrpWithTinv₁ r' :=
{ obj := λ M,
  { M := rescale N M,
    exhaustive' := λ x,
    begin
      obtain ⟨c, hc⟩ := M.exhaustive r' (rescale.of.symm x),
      refine ⟨c * N, _⟩,
      rw rescale.mem_filtration,
      rwa mul_inv_cancel_right₀,
      exact (fact.out _ : 0 < N).ne'
    end },
  map := λ M₁ M₂ f, rescale.map_comphaus_filtered_pseudo_normed_group_with_Tinv_hom _ _ f, }
.

@[simps]
def rescale_out (N : ℝ≥0) [fact (1 ≤ N)] :
  rescale r' N ⟶ 𝟭 _ :=
{ app := λ M,
  { to_fun := (rescale.of.symm : _root_.rescale N M → M),
    map_zero' := rfl,
    map_add' := λ x y, rfl,
    strict' := λ c x hx, pseudo_normed_group.filtration_mono (fact.out _) hx,
    continuous' := λ c, comphaus_filtered_pseudo_normed_group.continuous_cast_le (c * N⁻¹) c,
    map_Tinv' := λ x, rfl } }

end ProFiltPseuNormGrpWithTinv₁


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.shift
import Mathlib.category_theory.concrete_category.default
import Mathlib.PostPort

universes v u l u_1

namespace Mathlib

/-!
# Differential objects in a category.

A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.

We build the category of differential objects, and some basic constructions
such as the forgetful functor, and zero morphisms and zero objects.
-/

namespace category_theory

/--
A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.
-/
structure differential_object (C : Type u) [category C] [limits.has_zero_morphisms C] [has_shift C]
    where
  X : C
  d : X ⟶ functor.obj (equivalence.functor (shift C ^ 1)) X
  d_squared' :
    autoParam (d ≫ functor.map (equivalence.functor (shift C ^ 1)) d = 0)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem differential_object.d_squared {C : Type u} [category C]
    [limits.has_zero_morphisms C] [has_shift C] (c : differential_object C) :
    differential_object.d c ≫
          functor.map (equivalence.functor (shift C)) (differential_object.d c) =
        0 :=
  sorry

namespace differential_object

/--
A morphism of differential objects is a morphism commuting with the differentials.
-/
structure hom {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    (X : differential_object C) (Y : differential_object C)
    where
  f : X X ⟶ X Y
  comm' :
    autoParam (d X ≫ functor.map (equivalence.functor (shift C ^ 1)) f = f ≫ d Y)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.comm {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    {X : differential_object C} {Y : differential_object C} (c : hom X Y) :
    d X ≫ functor.map (equivalence.functor (shift C)) (hom.f c) = hom.f c ≫ d Y :=
  sorry

@[simp] theorem hom.comm_assoc {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    {X : differential_object C} {Y : differential_object C} (c : hom X Y) {X' : C}
    (f' : functor.obj (equivalence.functor (shift C)) (X Y) ⟶ X') :
    d X ≫ functor.map (equivalence.functor (shift C)) (hom.f c) ≫ f' = hom.f c ≫ d Y ≫ f' :=
  sorry

namespace hom

/-- The identity morphism of a differential object. -/
@[simp] theorem id_f {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    (X : differential_object C) : f (id X) = 𝟙 :=
  Eq.refl (f (id X))

/-- The composition of morphisms of differential objects. -/
@[simp] theorem comp_f {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    {X : differential_object C} {Y : differential_object C} {Z : differential_object C}
    (f : hom X Y) (g : hom Y Z) : f (comp f g) = f f ≫ f g :=
  Eq.refl (f (comp f g))

end hom

protected instance category_of_differential_objects {C : Type u} [category C]
    [limits.has_zero_morphisms C] [has_shift C] : category (differential_object C) :=
  category.mk

@[simp] theorem id_f {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    (X : differential_object C) : hom.f 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_f {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    {X : differential_object C} {Y : differential_object C} {Z : differential_object C} (f : X ⟶ Y)
    (g : Y ⟶ Z) : hom.f (f ≫ g) = hom.f f ≫ hom.f g :=
  rfl

/-- The forgetful functor taking a differential object to its underlying object. -/
def forget (C : Type u) [category C] [limits.has_zero_morphisms C] [has_shift C] :
    differential_object C ⥤ C :=
  functor.mk (fun (X : differential_object C) => X X)
    fun (X Y : differential_object C) (f : X ⟶ Y) => hom.f f

protected instance forget_faithful (C : Type u) [category C] [limits.has_zero_morphisms C]
    [has_shift C] : faithful (forget C) :=
  faithful.mk

protected instance has_zero_morphisms (C : Type u) [category C] [limits.has_zero_morphisms C]
    [has_shift C] : limits.has_zero_morphisms (differential_object C) :=
  limits.has_zero_morphisms.mk

@[simp] theorem zero_f {C : Type u} [category C] [limits.has_zero_morphisms C] [has_shift C]
    (P : differential_object C) (Q : differential_object C) : hom.f 0 = 0 :=
  rfl

end differential_object

end category_theory

namespace category_theory

namespace differential_object

protected instance has_zero_object (C : Type u) [category C] [limits.has_zero_object C]
    [limits.has_zero_morphisms C] [has_shift C] : limits.has_zero_object (differential_object C) :=
  limits.has_zero_object.mk (mk 0 0)
    (fun (X : differential_object C) => unique.mk { default := hom.mk 0 } sorry)
    fun (X : differential_object C) => unique.mk { default := hom.mk 0 } sorry

end differential_object

namespace differential_object

protected instance concrete_category_of_differential_objects (C : Type (u + 1)) [large_category C]
    [concrete_category C] [limits.has_zero_morphisms C] [has_shift C] :
    concrete_category (differential_object C) :=
  concrete_category.mk (forget C ⋙ forget C)

protected instance category_theory.has_forget₂ (C : Type (u + 1)) [large_category C]
    [concrete_category C] [limits.has_zero_morphisms C] [has_shift C] :
    has_forget₂ (differential_object C) C :=
  has_forget₂.mk (forget C)

end Mathlib