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

! This file was ported from Lean 3 source module linear_algebra.affine_space.affine_equiv
! leanprover-community/mathlib commit bd1fc183335ea95a9519a1630bcf901fe9326d83
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.AffineSpace.AffineMap
import Mathlib.LinearAlgebra.GeneralLinearGroup
import Mathlib.Algebra.Invertible

/-!
# Affine equivalences

In this file we define `AffineEquiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂`, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `AffineEquiv.refl k P`: the identity map as an `AffineEquiv`;

* `e.symm`: the inverse map of an `AffineEquiv` as an `AffineEquiv`;

* `e.trans e'`: composition of two `AffineEquiv`s; note that the order follows `mathlib`'s
  `CategoryTheory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

We equip `AffineEquiv k P P` with a `Group` structure with multiplication corresponding to
composition in `AffineEquiv.group`.

## Tags

affine space, affine equivalence
-/

open Function Set

open Affine

-- Porting note: this is needed because of lean4#2074
attribute [-instance] Ring.toNonAssocRing

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `Equiv` for the map and a `LinearEquiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
--@[nolint has_nonempty_instance]
structure AffineEquiv (k P₁ P₂ : Type _) {V₁ V₂ : Type _} [Ring k] [AddCommGroup V₁] [Module k V₁]
  [AddTorsor V₁ P₁] [AddCommGroup V₂] [Module k V₂] [AddTorsor V₂ P₂] extends P₁ ≃ P₂ where
  linear : V₁ ≃ₗ[k] V₂
  map_vadd' : ∀ (p : P₁) (v : V₁), toEquiv (v +ᵥ p) = linear v +ᵥ toEquiv p
#align affine_equiv AffineEquiv

notation:25 P₁ " ≃ᵃ[" k:25 "] " P₂:0 => AffineEquiv k P₁ P₂

variable {k P₁ P₂ P₃ P₄ V₁ V₂ V₃ V₄ : Type _} [Ring k] [AddCommGroup V₁] [Module k V₁]
  [AddTorsor V₁ P₁] [AddCommGroup V₂] [Module k V₂] [AddTorsor V₂ P₂] [AddCommGroup V₃]
  [Module k V₃] [AddTorsor V₃ P₃] [AddCommGroup V₄] [Module k V₄] [AddTorsor V₄ P₄]

namespace AffineEquiv

/-- Reinterpret an `AffineEquiv` as an `AffineMap`. -/
@[coe]
def toAffineMap (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ :=
  { e with }
#align affine_equiv.to_affine_map AffineEquiv.toAffineMap

@[simp]
theorem toAffineMap_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
    toAffineMap (mk f f' h) = ⟨f, f', h⟩ :=
  rfl
#align affine_equiv.to_affine_map_mk AffineEquiv.toAffineMap_mk

@[simp]
theorem linear_toAffineMap (e : P₁ ≃ᵃ[k] P₂) : e.toAffineMap.linear = e.linear :=
  rfl
#align affine_equiv.linear_to_affine_map AffineEquiv.linear_toAffineMap

theorem toAffineMap_injective : Injective (toAffineMap : (P₁ ≃ᵃ[k] P₂) → P₁ →ᵃ[k] P₂) := by
  rintro ⟨e, el, h⟩ ⟨e', el', h'⟩ H
  -- porting note: added `()`s and `AffineMap.mk.injEq`
  simp only [(toAffineMap_mk), (AffineMap.mk.injEq), Equiv.coe_inj,
    LinearEquiv.toLinearMap_inj] at H
  congr
  exacts [H.1, H.2]
#align affine_equiv.to_affine_map_injective AffineEquiv.toAffineMap_injective

@[simp]
theorem toAffineMap_inj {e e' : P₁ ≃ᵃ[k] P₂} : e.toAffineMap = e'.toAffineMap ↔ e = e' :=
  toAffineMap_injective.eq_iff
#align affine_equiv.to_affine_map_inj AffineEquiv.toAffineMap_inj

instance equivLike : EquivLike (P₁ ≃ᵃ[k] P₂) P₁ P₂ where
  coe f := f.toFun
  inv f := f.invFun
  left_inv f := f.left_inv
  right_inv f := f.right_inv
  coe_injective' _ _ h _ := toAffineMap_injective (FunLike.coe_injective h)
#align affine_equiv.equiv_like AffineEquiv.equivLike

instance : CoeFun (P₁ ≃ᵃ[k] P₂) fun _ => P₁ → P₂ :=
  FunLike.hasCoeToFun

@[nolint dangerousInstance] -- Porting note: this was not a problem in Lean 3
instance : Coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) :=
  ⟨AffineEquiv.toEquiv⟩

@[simp]
theorem map_vadd (e : P₁ ≃ᵃ[k] P₂) (p : P₁) (v : V₁) : e (v +ᵥ p) = e.linear v +ᵥ e p :=
  e.map_vadd' p v
#align affine_equiv.map_vadd AffineEquiv.map_vadd

@[simp]
theorem coe_toEquiv (e : P₁ ≃ᵃ[k] P₂) : ⇑e.toEquiv = e :=
  rfl
#align affine_equiv.coe_to_equiv AffineEquiv.coe_toEquiv

instance : Coe (P₁ ≃ᵃ[k] P₂) (P₁ →ᵃ[k] P₂) :=
  ⟨toAffineMap⟩

@[simp]
theorem coe_toAffineMap (e : P₁ ≃ᵃ[k] P₂) : (e.toAffineMap : P₁ → P₂) = (e : P₁ → P₂) :=
  rfl
#align affine_equiv.coe_to_affine_map AffineEquiv.coe_toAffineMap

@[norm_cast, simp]
theorem coe_coe (e : P₁ ≃ᵃ[k] P₂) : ((e : P₁ →ᵃ[k] P₂) : P₁ → P₂) = e :=
  rfl
#align affine_equiv.coe_coe AffineEquiv.coe_coe

@[simp]
theorem coe_linear (e : P₁ ≃ᵃ[k] P₂) : (e : P₁ →ᵃ[k] P₂).linear = e.linear :=
  rfl
#align affine_equiv.coe_linear AffineEquiv.coe_linear

@[ext]
theorem ext {e e' : P₁ ≃ᵃ[k] P₂} (h : ∀ x, e x = e' x) : e = e' :=
  FunLike.ext _ _ h
#align affine_equiv.ext AffineEquiv.ext

theorem coeFn_injective : @Injective (P₁ ≃ᵃ[k] P₂) (P₁ → P₂) (⇑) :=
  FunLike.coe_injective
#align affine_equiv.coe_fn_injective AffineEquiv.coeFn_injective

@[norm_cast]
-- Porting note: removed `simp`: proof is `simp only [FunLike.coe_fn_eq]`
theorem coeFn_inj {e e' : P₁ ≃ᵃ[k] P₂} : (e : P₁ → P₂) = e' ↔ e = e' :=
  coeFn_injective.eq_iff
#align affine_equiv.coe_fn_inj AffineEquiv.coeFn_inj

theorem toEquiv_injective : Injective (toEquiv : (P₁ ≃ᵃ[k] P₂) → P₁ ≃ P₂) := fun _ _ H =>
  ext <| Equiv.ext_iff.1 H
#align affine_equiv.to_equiv_injective AffineEquiv.toEquiv_injective

@[simp]

@[simp]
theorem coe_mk (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (h) : ((⟨e, e', h⟩ : P₁ ≃ᵃ[k] P₂) : P₁ → P₂) = e :=
  rfl
#align affine_equiv.coe_mk AffineEquiv.coe_mk

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes a map `e : P₁ → P₂`, a linear equivalence
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' (e : P₁ → P₂) (e' : V₁ ≃ₗ[k] V₂) (p : P₁) (h : ∀ p' : P₁, e p' = e' (p' -ᵥ p) +ᵥ e p) :
    P₁ ≃ᵃ[k] P₂ where
  toFun := e
  invFun := fun q' : P₂ => e'.symm (q' -ᵥ e p) +ᵥ p
  -- Porting note: `simp` needs `()`
  left_inv p' := by simp [h p', (vadd_vsub), (vsub_vadd)]
  -- Porting note: `simp` needs `()`
  right_inv q' := by simp [h (e'.symm (q' -ᵥ e p) +ᵥ p), (vadd_vsub), (vsub_vadd)]
  linear := e'
  -- Porting note: `simp` needs `()`
  map_vadd' p' v := by simp [h p', h (v +ᵥ p'), (vadd_vsub_assoc), (vadd_vadd)]
#align affine_equiv.mk' AffineEquiv.mk'

@[simp]
theorem coe_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) : ⇑(mk' e e' p h) = e :=
  rfl
#align affine_equiv.coe_mk' AffineEquiv.coe_mk'

@[simp]
theorem linear_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) : (mk' e e' p h).linear = e' :=
  rfl
#align affine_equiv.linear_mk' AffineEquiv.linear_mk'

/-- Inverse of an affine equivalence as an affine equivalence. -/
@[symm]
def symm (e : P₁ ≃ᵃ[k] P₂) : P₂ ≃ᵃ[k] P₁ where
  toEquiv := e.toEquiv.symm
  linear := e.linear.symm
  map_vadd' p v :=
    e.toEquiv.symm.apply_eq_iff_eq_symm_apply.2 <| by
      rw [Equiv.symm_symm, e.map_vadd' ((Equiv.symm e.toEquiv) p) ((LinearEquiv.symm e.linear) v),
        LinearEquiv.apply_symm_apply, Equiv.apply_symm_apply]
#align affine_equiv.symm AffineEquiv.symm

@[simp]
theorem symm_toEquiv (e : P₁ ≃ᵃ[k] P₂) : e.toEquiv.symm = e.symm.toEquiv :=
  rfl
#align affine_equiv.symm_to_equiv AffineEquiv.symm_toEquiv

@[simp]
theorem symm_linear (e : P₁ ≃ᵃ[k] P₂) : e.linear.symm = e.symm.linear :=
  rfl
#align affine_equiv.symm_linear AffineEquiv.symm_linear

/-- See Note [custom simps projection] -/
def Simps.apply (e : P₁ ≃ᵃ[k] P₂) : P₁ → P₂ :=
  e
#align affine_equiv.simps.apply AffineEquiv.Simps.apply

/-- See Note [custom simps projection] -/
def Simps.symmApply (e : P₁ ≃ᵃ[k] P₂) : P₂ → P₁ :=
  e.symm
#align affine_equiv.simps.symm_apply AffineEquiv.Simps.symmApply

initialize_simps_projections AffineEquiv (toEquiv_toFun → apply, toEquiv_invFun → symmApply,
  linear → linear, as_prefix linear, -toEquiv)

protected theorem bijective (e : P₁ ≃ᵃ[k] P₂) : Bijective e :=
  e.toEquiv.bijective
#align affine_equiv.bijective AffineEquiv.bijective

protected theorem surjective (e : P₁ ≃ᵃ[k] P₂) : Surjective e :=
  e.toEquiv.surjective
#align affine_equiv.surjective AffineEquiv.surjective

protected theorem injective (e : P₁ ≃ᵃ[k] P₂) : Injective e :=
  e.toEquiv.injective
#align affine_equiv.injective AffineEquiv.injective

/-- Bijective affine maps are affine isomorphisms. -/
@[simps! linear apply]
noncomputable def ofBijective {φ : P₁ →ᵃ[k] P₂} (hφ : Function.Bijective φ) : P₁ ≃ᵃ[k] P₂ :=
  { Equiv.ofBijective _ hφ with
    linear := LinearEquiv.ofBijective φ.linear (φ.linear_bijective_iff.mpr hφ)
    map_vadd' := φ.map_vadd }
#align affine_equiv.of_bijective AffineEquiv.ofBijective

theorem ofBijective.symm_eq {φ : P₁ →ᵃ[k] P₂} (hφ : Function.Bijective φ) :
    (ofBijective hφ).symm.toEquiv = (Equiv.ofBijective _ hφ).symm :=
  rfl
#align affine_equiv.of_bijective.symm_eq AffineEquiv.ofBijective.symm_eq

@[simp]
theorem range_eq (e : P₁ ≃ᵃ[k] P₂) : range e = univ :=
  e.surjective.range_eq
#align affine_equiv.range_eq AffineEquiv.range_eq

@[simp]
theorem apply_symm_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₂) : e (e.symm p) = p :=
  e.toEquiv.apply_symm_apply p
#align affine_equiv.apply_symm_apply AffineEquiv.apply_symm_apply

@[simp]
theorem symm_apply_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₁) : e.symm (e p) = p :=
  e.toEquiv.symm_apply_apply p
#align affine_equiv.symm_apply_apply AffineEquiv.symm_apply_apply

theorem apply_eq_iff_eq_symm_apply (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂} : e p₁ = p₂ ↔ p₁ = e.symm p₂ :=
  e.toEquiv.apply_eq_iff_eq_symm_apply
#align affine_equiv.apply_eq_iff_eq_symm_apply AffineEquiv.apply_eq_iff_eq_symm_apply

-- Porting note: removed `simp`, proof is `by simp only [@EmbeddingLike.apply_eq_iff_eq]`
theorem apply_eq_iff_eq (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂ : P₁} : e p₁ = e p₂ ↔ p₁ = p₂ :=
  e.toEquiv.apply_eq_iff_eq
#align affine_equiv.apply_eq_iff_eq AffineEquiv.apply_eq_iff_eq

@[simp]
theorem image_symm (f : P₁ ≃ᵃ[k] P₂) (s : Set P₂) : f.symm '' s = f ⁻¹' s :=
  f.symm.toEquiv.image_eq_preimage _
#align affine_equiv.image_symm AffineEquiv.image_symm

@[simp]
theorem preimage_symm (f : P₁ ≃ᵃ[k] P₂) (s : Set P₁) : f.symm ⁻¹' s = f '' s :=
  (f.symm.image_symm _).symm
#align affine_equiv.preimage_symm AffineEquiv.preimage_symm

variable (k P₁)

/-- Identity map as an `AffineEquiv`. -/
-- @[refl] -- Porting note: removed attribute
def refl : P₁ ≃ᵃ[k] P₁ where
  toEquiv := Equiv.refl P₁
  linear := LinearEquiv.refl k V₁
  map_vadd' _ _ := rfl
#align affine_equiv.refl AffineEquiv.refl

@[simp]
theorem coe_refl : ⇑(refl k P₁) = id :=
  rfl
#align affine_equiv.coe_refl AffineEquiv.coe_refl

@[simp]
theorem coe_refl_to_affineMap : ↑(refl k P₁) = AffineMap.id k P₁ :=
  rfl
#align affine_equiv.coe_refl_to_affine_map AffineEquiv.coe_refl_to_affineMap

@[simp]
theorem refl_apply (x : P₁) : refl k P₁ x = x :=
  rfl
#align affine_equiv.refl_apply AffineEquiv.refl_apply

@[simp]
theorem toEquiv_refl : (refl k P₁).toEquiv = Equiv.refl P₁ :=
  rfl
#align affine_equiv.to_equiv_refl AffineEquiv.toEquiv_refl

@[simp]
theorem linear_refl : (refl k P₁).linear = LinearEquiv.refl k V₁ :=
  rfl
#align affine_equiv.linear_refl AffineEquiv.linear_refl

@[simp]
theorem symm_refl : (refl k P₁).symm = refl k P₁ :=
  rfl
#align affine_equiv.symm_refl AffineEquiv.symm_refl

variable {k P₁}

/-- Composition of two `AffineEquiv`alences, applied left to right. -/
@[trans]
def trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : P₁ ≃ᵃ[k] P₃ where
  toEquiv := e.toEquiv.trans e'.toEquiv
  linear := e.linear.trans e'.linear
  map_vadd' p v := by
    -- porting note: added `()`
    simp only [LinearEquiv.trans_apply, (coe_toEquiv), (· ∘ ·), Equiv.coe_trans, (map_vadd)]
#align affine_equiv.trans AffineEquiv.trans

@[simp]
theorem coe_trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : ⇑(e.trans e') = e' ∘ e :=
  rfl
#align affine_equiv.coe_trans AffineEquiv.coe_trans

@[simp]
theorem coe_trans_to_affineMap (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) :
    (e.trans e' : P₁ →ᵃ[k] P₃) = (e' : P₂ →ᵃ[k] P₃).comp e :=
  rfl
#align affine_equiv.coe_trans_to_affine_map AffineEquiv.coe_trans_to_affineMap

@[simp]
theorem trans_apply (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) (p : P₁) : e.trans e' p = e' (e p) :=
  rfl
#align affine_equiv.trans_apply AffineEquiv.trans_apply

theorem trans_assoc (e₁ : P₁ ≃ᵃ[k] P₂) (e₂ : P₂ ≃ᵃ[k] P₃) (e₃ : P₃ ≃ᵃ[k] P₄) :
    (e₁.trans e₂).trans e₃ = e₁.trans (e₂.trans e₃) :=
  ext fun _ => rfl
#align affine_equiv.trans_assoc AffineEquiv.trans_assoc

@[simp]
theorem trans_refl (e : P₁ ≃ᵃ[k] P₂) : e.trans (refl k P₂) = e :=
  ext fun _ => rfl
#align affine_equiv.trans_refl AffineEquiv.trans_refl

@[simp]
theorem refl_trans (e : P₁ ≃ᵃ[k] P₂) : (refl k P₁).trans e = e :=
  ext fun _ => rfl
#align affine_equiv.refl_trans AffineEquiv.refl_trans

@[simp]
theorem self_trans_symm (e : P₁ ≃ᵃ[k] P₂) : e.trans e.symm = refl k P₁ :=
  ext e.symm_apply_apply
#align affine_equiv.self_trans_symm AffineEquiv.self_trans_symm

@[simp]
theorem symm_trans_self (e : P₁ ≃ᵃ[k] P₂) : e.symm.trans e = refl k P₂ :=
  ext e.apply_symm_apply
#align affine_equiv.symm_trans_self AffineEquiv.symm_trans_self

@[simp]
theorem apply_lineMap (e : P₁ ≃ᵃ[k] P₂) (a b : P₁) (c : k) :
    e (AffineMap.lineMap a b c) = AffineMap.lineMap (e a) (e b) c :=
  e.toAffineMap.apply_lineMap a b c
#align affine_equiv.apply_line_map AffineEquiv.apply_lineMap

instance group : Group (P₁ ≃ᵃ[k] P₁) where
  one := refl k P₁
  mul e e' := e'.trans e
  inv := symm
  mul_assoc e₁ e₂ e₃ := trans_assoc _ _ _
  one_mul := trans_refl
  mul_one := refl_trans
  mul_left_inv := self_trans_symm
#align affine_equiv.group AffineEquiv.group

theorem one_def : (1 : P₁ ≃ᵃ[k] P₁) = refl k P₁ :=
  rfl
#align affine_equiv.one_def AffineEquiv.one_def

@[simp]
theorem coe_one : ⇑(1 : P₁ ≃ᵃ[k] P₁) = id :=
  rfl
#align affine_equiv.coe_one AffineEquiv.coe_one

theorem mul_def (e e' : P₁ ≃ᵃ[k] P₁) : e * e' = e'.trans e :=
  rfl
#align affine_equiv.mul_def AffineEquiv.mul_def

@[simp]
theorem coe_mul (e e' : P₁ ≃ᵃ[k] P₁) : ⇑(e * e') = e ∘ e' :=
  rfl
#align affine_equiv.coe_mul AffineEquiv.coe_mul

theorem inv_def (e : P₁ ≃ᵃ[k] P₁) : e⁻¹ = e.symm :=
  rfl
#align affine_equiv.inv_def AffineEquiv.inv_def

/-- `AffineEquiv.linear` on automorphisms is a `MonoidHom`. -/
@[simps]
def linearHom : (P₁ ≃ᵃ[k] P₁) →* V₁ ≃ₗ[k] V₁ where
  toFun := linear
  map_one' := rfl
  map_mul' _ _ := rfl
#align affine_equiv.linear_hom AffineEquiv.linearHom

/-- The group of `AffineEquiv`s are equivalent to the group of units of `AffineMap`.

This is the affine version of `LinearMap.GeneralLinearGroup.generalLinearEquiv`. -/
@[simps]
def equivUnitsAffineMap : (P₁ ≃ᵃ[k] P₁) ≃* (P₁ →ᵃ[k] P₁)ˣ where
  toFun e :=
    { val := e, inv := e.symm,
      val_inv := congr_arg toAffineMap e.symm_trans_self
      inv_val := congr_arg toAffineMap e.self_trans_symm }
  invFun u :=
    { toFun := (u : P₁ →ᵃ[k] P₁)
      invFun := (↑u⁻¹ : P₁ →ᵃ[k] P₁)
      left_inv := AffineMap.congr_fun u.inv_mul
      right_inv := AffineMap.congr_fun u.mul_inv
      linear :=
        LinearMap.GeneralLinearGroup.generalLinearEquiv _ _ <| Units.map AffineMap.linearHom u
      map_vadd' := fun _ _ => (u : P₁ →ᵃ[k] P₁).map_vadd _ _ }
  left_inv _ := AffineEquiv.ext fun _ => rfl
  right_inv _ := Units.ext <| AffineMap.ext fun _ => rfl
  map_mul' _ _ := rfl
#align affine_equiv.equiv_units_affine_map AffineEquiv.equivUnitsAffineMap

variable (k)

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
@[simps! linear apply]
def vaddConst (b : P₁) : V₁ ≃ᵃ[k] P₁ where
  toEquiv := Equiv.vaddConst b
  linear := LinearEquiv.refl _ _
  map_vadd' _ _ := add_vadd _ _ _
#align affine_equiv.vadd_const AffineEquiv.vaddConst

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def constVSub (p : P₁) : P₁ ≃ᵃ[k] V₁ where
  toEquiv := Equiv.constVSub p
  linear := LinearEquiv.neg k
  -- porting note: added `coe_constVSub` and `()`s
  map_vadd' p' v := by simp [(Equiv.coe_constVSub), (vsub_vadd_eq_vsub_sub), neg_add_eq_sub]
#align affine_equiv.const_vsub AffineEquiv.constVSub

@[simp]
theorem coe_constVSub (p : P₁) : ⇑(constVSub k p) = (· -ᵥ ·) p :=
  rfl
#align affine_equiv.coe_const_vsub AffineEquiv.coe_constVSub

@[simp]
theorem coe_constVSub_symm (p : P₁) : ⇑(constVSub k p).symm = fun v : V₁ => -v +ᵥ p :=
  rfl
#align affine_equiv.coe_const_vsub_symm AffineEquiv.coe_constVSub_symm

variable (P₁)

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space.

Note that there is no need for an `AffineMap.constVAdd` as it is always an equivalence.
This is roughly to `DistribMulAction.toLinearEquiv` as `+ᵥ` is to `•`. -/
@[simps! apply linear]
def constVAdd (v : V₁) : P₁ ≃ᵃ[k] P₁ where
  toEquiv := Equiv.constVAdd P₁ v
  linear := LinearEquiv.refl _ _
  map_vadd' _ _ := vadd_comm _ _ _
#align affine_equiv.const_vadd AffineEquiv.constVAdd

@[simp]
theorem constVAdd_zero : constVAdd k P₁ 0 = AffineEquiv.refl _ _ :=
  ext <| zero_vadd _
#align affine_equiv.const_vadd_zero AffineEquiv.constVAdd_zero

@[simp]
theorem constVAdd_add (v w : V₁) :
    constVAdd k P₁ (v + w) = (constVAdd k P₁ w).trans (constVAdd k P₁ v) :=
  ext <| add_vadd _ _
#align affine_equiv.const_vadd_add AffineEquiv.constVAdd_add

@[simp]
theorem constVAdd_symm (v : V₁) : (constVAdd k P₁ v).symm = constVAdd k P₁ (-v) :=
  ext fun _ => rfl
#align affine_equiv.const_vadd_symm AffineEquiv.constVAdd_symm

/-- A more bundled version of `AffineEquiv.constVAdd`. -/
@[simps]
def constVAddHom : Multiplicative V₁ →* P₁ ≃ᵃ[k] P₁ where
  toFun v := constVAdd k P₁ (Multiplicative.toAdd v)
  map_one' := constVAdd_zero _ _
  map_mul' := constVAdd_add _ P₁
#align affine_equiv.const_vadd_hom AffineEquiv.constVAddHom

theorem constVAdd_nsmul (n : ℕ) (v : V₁) : constVAdd k P₁ (n • v) = constVAdd k P₁ v ^ n :=
  (constVAddHom k P₁).map_pow _ _
#align affine_equiv.const_vadd_nsmul AffineEquiv.constVAdd_nsmul

theorem constVAdd_zsmul (z : ℤ) (v : V₁) : constVAdd k P₁ (z • v) = constVAdd k P₁ v ^ z :=
  (constVAddHom k P₁).map_zpow _ _
#align affine_equiv.const_vadd_zsmul AffineEquiv.constVAdd_zsmul

section Homothety

variable {R V P : Type _} [CommRing R] [AddCommGroup V] [Module R V] [AffineSpace V P]

/-- Fixing a point in affine space, homothety about this point gives a group homomorphism from (the
centre of) the units of the scalars into the group of affine equivalences. -/
def homothetyUnitsMulHom (p : P) : Rˣ →* P ≃ᵃ[R] P :=
  equivUnitsAffineMap.symm.toMonoidHom.comp <| Units.map (AffineMap.homothetyHom p)
#align affine_equiv.homothety_units_mul_hom AffineEquiv.homothetyUnitsMulHom

@[simp]
theorem coe_homothetyUnitsMulHom_apply (p : P) (t : Rˣ) :
    (homothetyUnitsMulHom p t : P → P) = AffineMap.homothety p (t : R) :=
  rfl
#align affine_equiv.coe_homothety_units_mul_hom_apply AffineEquiv.coe_homothetyUnitsMulHom_apply

@[simp]
theorem coe_homothetyUnitsMulHom_apply_symm (p : P) (t : Rˣ) :
    ((homothetyUnitsMulHom p t).symm : P → P) = AffineMap.homothety p (↑t⁻¹ : R) :=
  rfl
#align affine_equiv.coe_homothety_units_mul_hom_apply_symm AffineEquiv.coe_homothetyUnitsMulHom_apply_symm

@[simp]
theorem coe_homothetyUnitsMulHom_eq_homothetyHom_coe (p : P) :
    ((↑) : (P ≃ᵃ[R] P) → P →ᵃ[R] P) ∘ homothetyUnitsMulHom p =
      AffineMap.homothetyHom p ∘ ((↑) : Rˣ → R) :=
  funext fun _ => rfl
#align affine_equiv.coe_homothety_units_mul_hom_eq_homothety_hom_coe AffineEquiv.coe_homothetyUnitsMulHom_eq_homothetyHom_coe

end Homothety

variable {P₁}

open Function

/-- Point reflection in `x` as a permutation. -/
def pointReflection (x : P₁) : P₁ ≃ᵃ[k] P₁ :=
  (constVSub k x).trans (vaddConst k x)
#align affine_equiv.point_reflection AffineEquiv.pointReflection

theorem pointReflection_apply (x y : P₁) : pointReflection k x y = x -ᵥ y +ᵥ x :=
  rfl
#align affine_equiv.point_reflection_apply AffineEquiv.pointReflection_apply

@[simp]
theorem pointReflection_symm (x : P₁) : (pointReflection k x).symm = pointReflection k x :=
  toEquiv_injective <| Equiv.pointReflection_symm x
#align affine_equiv.point_reflection_symm AffineEquiv.pointReflection_symm

@[simp]
theorem toEquiv_pointReflection (x : P₁) :
    (pointReflection k x).toEquiv = Equiv.pointReflection x :=
  rfl
#align affine_equiv.to_equiv_point_reflection AffineEquiv.toEquiv_pointReflection

@[simp]
theorem pointReflection_self (x : P₁) : pointReflection k x x = x :=
  vsub_vadd _ _
#align affine_equiv.point_reflection_self AffineEquiv.pointReflection_self

theorem pointReflection_involutive (x : P₁) : Involutive (pointReflection k x : P₁ → P₁) :=
  Equiv.pointReflection_involutive x
#align affine_equiv.point_reflection_involutive AffineEquiv.pointReflection_involutive

set_option linter.deprecated false in
/-- `x` is the only fixed point of `pointReflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
theorem pointReflection_fixed_iff_of_injective_bit0 {x y : P₁} (h : Injective (bit0 : V₁ → V₁)) :
    pointReflection k x y = y ↔ y = x :=
  Equiv.pointReflection_fixed_iff_of_injective_bit0 h
#align affine_equiv.point_reflection_fixed_iff_of_injective_bit0 AffineEquiv.pointReflection_fixed_iff_of_injective_bit0

set_option linter.deprecated false in
theorem injective_pointReflection_left_of_injective_bit0 (h : Injective (bit0 : V₁ → V₁)) (y : P₁) :
    Injective fun x : P₁ => pointReflection k x y :=
  Equiv.injective_pointReflection_left_of_injective_bit0 h y
#align affine_equiv.injective_point_reflection_left_of_injective_bit0 AffineEquiv.injective_pointReflection_left_of_injective_bit0

theorem injective_pointReflection_left_of_module [Invertible (2 : k)] :
    ∀ y, Injective fun x : P₁ => pointReflection k x y :=
  injective_pointReflection_left_of_injective_bit0 k fun x y h => by
    rwa [bit0, bit0, ← two_smul k x, ← two_smul k y,
      (isUnit_of_invertible (2 : k)).smul_left_cancel] at h
#align affine_equiv.injective_point_reflection_left_of_module AffineEquiv.injective_pointReflection_left_of_module

theorem pointReflection_fixed_iff_of_module [Invertible (2 : k)] {x y : P₁} :
    pointReflection k x y = y ↔ y = x :=
  ((injective_pointReflection_left_of_module k y).eq_iff' (pointReflection_self k y)).trans eq_comm
#align affine_equiv.point_reflection_fixed_iff_of_module AffineEquiv.pointReflection_fixed_iff_of_module

end AffineEquiv

namespace LinearEquiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def toAffineEquiv (e : V₁ ≃ₗ[k] V₂) : V₁ ≃ᵃ[k] V₂ where
  toEquiv := e.toEquiv
  linear := e
  map_vadd' p v := e.map_add v p
#align linear_equiv.to_affine_equiv LinearEquiv.toAffineEquiv

@[simp]
theorem coe_toAffineEquiv (e : V₁ ≃ₗ[k] V₂) : ⇑e.toAffineEquiv = e :=
  rfl
#align linear_equiv.coe_to_affine_equiv LinearEquiv.coe_toAffineEquiv

end LinearEquiv

namespace AffineMap

open AffineEquiv

theorem lineMap_vadd (v v' : V₁) (p : P₁) (c : k) :
    lineMap v v' c +ᵥ p = lineMap (v +ᵥ p) (v' +ᵥ p) c :=
  (vaddConst k p).apply_lineMap v v' c
#align affine_map.line_map_vadd AffineMap.lineMap_vadd

theorem lineMap_vsub (p₁ p₂ p₃ : P₁) (c : k) :
    lineMap p₁ p₂ c -ᵥ p₃ = lineMap (p₁ -ᵥ p₃) (p₂ -ᵥ p₃) c :=
  (vaddConst k p₃).symm.apply_lineMap p₁ p₂ c
#align affine_map.line_map_vsub AffineMap.lineMap_vsub

theorem vsub_lineMap (p₁ p₂ p₃ : P₁) (c : k) :
    p₁ -ᵥ lineMap p₂ p₃ c = lineMap (p₁ -ᵥ p₂) (p₁ -ᵥ p₃) c :=
  (constVSub k p₁).apply_lineMap p₂ p₃ c
#align affine_map.vsub_line_map AffineMap.vsub_lineMap

theorem vadd_lineMap (v : V₁) (p₁ p₂ : P₁) (c : k) :
    v +ᵥ lineMap p₁ p₂ c = lineMap (v +ᵥ p₁) (v +ᵥ p₂) c :=
  (constVAdd k P₁ v).apply_lineMap p₁ p₂ c
#align affine_map.vadd_line_map AffineMap.vadd_lineMap

variable {R' : Type _} [CommRing R'] [Module R' V₁]

theorem homothety_neg_one_apply (c p : P₁) : homothety c (-1 : R') p = pointReflection R' c p := by
  -- porting note: added `()`, `_`, and `neg_vsub_eq_vsub_rev`
  simp [(homothety_apply), pointReflection_apply _, (neg_vsub_eq_vsub_rev)]
#align affine_map.homothety_neg_one_apply AffineMap.homothety_neg_one_apply

end AffineMap


class One (α : Type u) where
  one : α

instance One.toOfNat1 {α} [One α] : OfNat α (nat_lit 1) where
  ofNat := ‹One α›.1

class MulOneClass (M : Type u) extends One M, Mul M

class FunLike (F : Sort _) (α : outParam (Sort _)) (β : outParam <| α → Sort _) where
  coe : F → ∀ a : α, β a

instance (priority := 100) [FunLike F α β] : CoeFun F fun _ => ∀ a : α, β a where coe := FunLike.coe

section One

variable [One M] [One N]

structure OneHom (M : Type _) (N : Type _) [One M] [One N] where
  toFun : M → N
  map_one' : toFun 1 = 1

class OneHomClass (F : Type _) (M N : outParam (Type _)) [One M] [One N]
  extends FunLike F M fun _ => N where
  map_one : ∀ f : F, f 1 = 1

@[simp]
theorem map_one [OneHomClass F M N] (f : F) : f 1 = 1 :=
  OneHomClass.map_one f

end One

section Mul

variable [Mul M] [Mul N]

structure MulHom (M : Type _) (N : Type _) [Mul M] [Mul N] where
  toFun : M → N
  map_mul' : ∀ x y, toFun (x * y) = toFun x * toFun y

infixr:25 " →ₙ* " => MulHom

class MulHomClass (F : Type _) (M N : outParam (Type _)) [Mul M] [Mul N]
  extends FunLike F M fun _ => N where
  map_mul : ∀ (f : F) (x y : M), f (x * y) = f x * f y

@[simp]
theorem map_mul [MulHomClass F M N] (f : F) (x y : M) : f (x * y) = f x * f y :=
  MulHomClass.map_mul f x y

end Mul

section mul_one

variable [MulOneClass M] [MulOneClass N]

structure MonoidHom (M : Type _) (N : Type _) [MulOneClass M] [MulOneClass N] extends
  OneHom M N, M →ₙ* N

infixr:25 " →* " => MonoidHom

class MonoidHomClass (F : Type _) (M N : outParam (Type _)) [MulOneClass M] [MulOneClass N] extends MulHomClass F M N, OneHomClass F M N

instance (F : Type _) (M N : outParam (Type _)) [MulOneClass M] [MulOneClass N] [MonoidHomClass F M N] : CoeTC F (M →* N) :=
  ⟨fun f => {
   toFun := f,
   map_one' := map_one f,
   map_mul' := map_mul f
  }⟩

-- Now we reverse the order of the parents in the extends clause:
class MonoidHomClass' (F : Type _) (M N : outParam (Type _)) [MulOneClass M] [MulOneClass N] extends OneHomClass F M N, MulHomClass F M N

instance [MonoidHomClass' F M N] : CoeTC F (M →* N) :=
  ⟨fun f => {
    toFun := f,
    map_one' := map_one f,
    map_mul' := map_mul f
  }⟩


/- -----------------------------------------------------------------------
Dependent lists.
----------------------------------------------------------------------- -/

import .c1_fin

namespace qp
namespace stdaux

universe variables ℓ₁ ℓ₂

/-! #brief A dependent list.
-/
inductive dlist {A : Type ℓ₁} (B : A → Sort ℓ₂) : list A → Type (max ℓ₁ ℓ₂)
| nil : dlist []
| cons : ∀ (a : A) (b : B a) (aa : list A) (bb : dlist aa)
         , dlist (a :: aa)

-- notation `][` := dlist.nil _
-- notation h ` :Σ: ` t  := dlist.cons _ h _ t

/-! #brief Equality of dlists.
-/
definition dlist.eq {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {a : A} {aa : list A}
         {b₁ b₂ : B a}
         {bb₁ bb₂ : dlist B aa}
         (ωb : b₁ = b₂)
         (ωbb : bb₁ = bb₂)
       , dlist.cons a b₁ aa bb₁ = dlist.cons a b₂ aa bb₂
| a aa b .(b) bb .(bb) (eq.refl .(b)) (eq.refl .(bb)) := rfl

-- /-! #brief The head of a dlist.
-- -/
-- definition dlist.head {A : Type ℓ₁} {B : A → Sort ℓ₂}
--     : ∀ {a:  A} {aa : list A}
--         (bb : dlist B (a :: aa))
--       , B a
-- | a aa (dlist.cons .a b .aa bb) := b

/-! #brief Mapping across a dependent list.
-/
definition dlist.map {A : Type ℓ₁} {B₁ B₂ : A → Sort ℓ₂} (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa : list A}
      , dlist B₁ aa → dlist B₂ aa
| [] bb := dlist.nil B₂
| (a :: aa) (dlist.cons .(a) b .(aa) bb) := dlist.cons a (f b) aa (dlist.map bb)

/-! #brief Mapping a map.
-/
theorem dlist.map_map {A : Type ℓ₁} {B₁ B₂ B₃ : A → Sort ℓ₂}
    (g : ∀ {a : A}, B₂ a → B₃ a)
    (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa : list A} {bb : dlist B₁ aa}
      , dlist.map @g (dlist.map @f bb) = dlist.map (λ a b, g (f b)) bb
| [] bb := rfl
| (a :: aa) (dlist.cons .(a) b .(aa) bb)
:= begin
     apply dlist.eq,
     { trivial },
     { apply dlist.map_map }
   end

/-! #brief Getting an item out of a dependent list.
-/
definition dlist.get {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa : list A}
        (bb : dlist B aa)
        (n : fin (list.length aa))
      , B (list.get aa n)
| [] bb n := fin.zero_elim n
| (a :: aa) (dlist.cons .(a) b .(aa) bb) (fin.mk 0 ω) := b
| (a :: aa) (dlist.cons .(a) b .(aa) bb) (fin.mk (nat.succ n) ω)
:= dlist.get bb { val := n, is_lt := nat.lt_of_succ_lt_succ ω }

theorem dlist.get.simp {A : Type ℓ₁} {B : A → Sort ℓ₂}
    (a : A) (b : B a) (aa : list A) (bb : dlist B aa)
    (n : ℕ) (ω : nat.succ n < list.length (a :: aa))
    : dlist.get (dlist.cons a b aa bb) { val := nat.succ n, is_lt := ω }
       == dlist.get bb { val := n, is_lt := nat.lt_of_succ_lt_succ ω }
:= heq.refl _

/-! #brief Congruence for dlist.get.
-/
theorem dlist.congr_get {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {aa : list A} {bb₁ bb₂ : dlist B aa}
    (ωbb : bb₁ = bb₂) (n : fin (list.length aa))
    : dlist.get bb₁ n = dlist.get bb₂ n
:= by rw ωbb

/-! #brief Getting an item out of a map.
-/
theorem dlist.get_map {A : Type ℓ₁} {B₁ B₂ : A → Sort ℓ₂} (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa : list A} (bb : dlist B₁ aa)
        (n : fin (list.length aa))
      , dlist.get (dlist.map @f bb) n = f (dlist.get bb n)
| [] bb n := fin.zero_elim n
| (a :: aa) (dlist.cons .(a) b .(aa) bb) (fin.mk 0 ω) := rfl
| (a :: aa) (dlist.cons .(a) b .(aa) bb) (fin.mk (nat.succ n) ω)
:= begin
     dsimp [dlist.map],
     apply eq_of_heq,
     apply heq.trans (dlist.get.simp a (f b) aa (dlist.map @f bb) n ω),
     apply heq_of_eq,
     apply dlist.get_map
   end

/-! #brief Dropping the bottom out of a finite function.
-/
definition fin.drop {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {a : A} {aa : list A}
    (f : ∀ (n : fin (list.length (a :: aa))), B (list.get (a :: aa) n))
    : ∀ (n : fin (list.length aa))
      , B (list.get aa n)
| (fin.mk n ω) := f { val := nat.succ n, is_lt := nat.succ_lt_succ ω }

/-! #brief Dropping on get.
-/
theorem dlist.drop_get {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {a : A} {b : B a} {aa : list A} {bb : dlist B aa}
         {n : ℕ} {ω : n < list.length aa}
      , dlist.get (dlist.cons a b aa bb) (fin.mk (nat.succ n) (nat.succ_lt_succ ω)) == dlist.get bb (fin.mk n ω)
| a b [] bb n ω := fin.zero_elim (fin.mk n ω)
| a₁ b₁ (a₂ :: aa) (dlist.cons .(a₂) b₂ .(aa) bb) 0 ω := heq.refl _
| a₁ b₁ (a₂ :: aa) (dlist.cons .(a₂) b₂ .(aa) bb) (nat.succ n) ω
:= begin
     refine heq.trans (dlist.get.simp _ _ _ _ _ _) _,
     refine heq.trans (@dlist.drop_get _ _ _ _ n (nat.lt_of_succ_lt_succ ω)) _,
     apply heq.symm,
     apply dlist.get.simp
   end

/-! #brief Inverse of dlist.get.
-/
definition dlist.enum {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa : list A}
        (f : ∀ (n : fin (list.length aa)), B (list.get aa n))
      , dlist B aa
| [] f := dlist.nil B
| (a :: aa) f := dlist.cons a (f fin.zero) aa (dlist.enum (fin.drop f))

/-! #brief When an enum is equal to a map.
-/
theorem dlist.enum_eq_map {A : Type ℓ₁} {B₁ B₂ : A → Sort ℓ₂} (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa : list A} (bb : dlist B₁ aa)
        (h : ∀ (n : fin (list.length aa)), B₂ (list.get aa n))
        (ωh : ∀ (n : fin (list.length aa)), h n = f (dlist.get bb n))
      , dlist.enum h = @dlist.map A B₁ B₂ @f aa bb
| [] bb h ωh := rfl
| (a :: aa) (dlist.cons .(a) b .(aa) bb) h ωh
:= begin
     dsimp [dlist.enum, dlist.map],
     rw ωh,
     apply congr_arg,
     apply dlist.enum_eq_map,
     intro n, cases n with n ωn,
     dsimp [fin.drop],
     rw ωh,
     trivial
   end

/-! #brief Getting an item out of an enumerated dlist.
-/
theorem dlist.get_enum {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa : list A}
        (f : ∀ (n : fin (list.length aa)), B (list.get aa n))
        (n : fin (list.length aa))
      , dlist.get (dlist.enum f) n = f n
| [] f n := fin.zero_elim n
| (a :: aa) f (fin.mk 0 ω) := rfl
| (a :: aa) f (fin.mk (nat.succ n) ω)
:= begin
     dsimp [dlist.enum, dlist.get],
     apply eq_of_heq,
     apply heq.trans (dlist.get.simp a (f fin.zero) aa _ n ω),
     apply heq_of_eq,
     apply eq.trans (dlist.get_enum (fin.drop f) _),
     trivial
   end

/-! #brief Enumerating the dlist.get function.
-/
theorem dlist.enum_get {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa : list A}
        {bb : dlist B aa}
      , dlist.enum (dlist.get bb) = bb
| [] bb := begin cases bb, trivial end
| (a :: aa) (dlist.cons .(a) b .(aa) bb)
:= begin
     apply dlist.eq,
     { trivial },
     { refine eq.trans _ dlist.enum_get,
       apply congr_arg dlist.enum,
       apply funext,
       intro n, cases n with n ωn,
       unfold fin.drop,
       apply eq_of_heq,
       apply dlist.drop_get
     }
   end

/-! #brief dlist.get is injective.
-/
theorem dlist.get.inj {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {aa : list A}
    {bb₁ bb₂ : dlist B aa}
    (ω : dlist.get bb₁ = dlist.get bb₂)
    : bb₁ = bb₂
:= by calc bb₁ = dlist.enum (dlist.get bb₁) : eq.symm dlist.enum_get
           ... = dlist.enum (dlist.get bb₂) : by rw ω
           ... = bb₂                        : dlist.enum_get

/-! #brief Appending dlists.
-/
definition dlist.append {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ : list A} (bb₁ : dlist B aa₁)
        {aa₂ : list A} (bb₂ : dlist B aa₂)
      , dlist B (aa₁ ++ aa₂)
| [] bb₁ aa₂ bb₂ := bb₂
| (a :: aa₁) (dlist.cons .(a) b .(aa₁) bb₁) aa₂ bb₂ := dlist.cons a b (aa₁ ++ aa₂) (dlist.append bb₁ bb₂)

/-! #brief Splitting apart a dlist at an append (left part).
-/
definition dlist.split_left {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ (aa₁ : list A) {aa₂ : list A}
        (bb : dlist B (aa₁ ++ aa₂))
      , dlist B aa₁
:= λ aa₁ aa₂ bb
   , begin
       induction aa₁ with a aa₁ rec,
       { exact dlist.nil B },
       { cases bb with a b aa₁ bb', apply dlist.cons _ b _, exact rec bb' }
     end

/-! #brief Splitting apart a dlist at an append (right part).
-/
definition dlist.split_right {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ (aa₁ : list A) {aa₂ : list A}
        (bb : dlist B (aa₁ ++ aa₂))
      , dlist B aa₂
:= λ aa₁ aa₂ bb
   , begin
       induction aa₁ with a aa₁ rec,
       { exact bb },
       { cases bb with a b aa₁ bb', exact rec bb'}
     end

/-! #brief Appending the splits.
-/
theorem dlist.append_split {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb : dlist B (aa₁ ++ aa₂)}
      , dlist.append (dlist.split_left _ bb) (dlist.split_right _ bb)
         = bb
:= λ aa₁ aa₂ bb
   , begin
       induction aa₁ with a aa₁ rec,
       { trivial },
       { cases bb with a b aa₁ bb',
         apply dlist.eq,
         { trivial },
         { apply rec }
       }
     end

/-! #brief Equality of appended dlists.
-/
theorem dlist.append_eq {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {aa₁ aa₂ : list A}
    {bb₁ bb₂ : dlist B (aa₁ ++ aa₂)}
    (ωleft : dlist.split_left _ bb₁ = dlist.split_left _ bb₂)
    (ωright : dlist.split_right _ bb₁ = dlist.split_right _ bb₂)
    : bb₁ = bb₂
:= begin
     refine eq.trans (eq.symm dlist.append_split) _,
     refine eq.trans _ (dlist.append_split),
     rw [ωleft, ωright]
   end

/-! #brief Splitting an append.
-/
theorem dlist.split_left_append {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb₁ : dlist B aa₁} {bb₂ : dlist B aa₂}
      , dlist.split_left aa₁ (dlist.append bb₁ bb₂)
         = bb₁
| aa₁ aa₂ bb₁ bb₂
:= begin
     induction aa₁ with a aa₁ rec,
     { cases bb₁ with a b aa₁ bb₁, trivial },
     { cases bb₁ with a b aa₁ bb₁,
       apply dlist.eq,
       { trivial },
       { apply rec }
     }
   end

/-! #brief Splitting an append.
-/
theorem dlist.split_right_append {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb₁ : dlist B aa₁} {bb₂ : dlist B aa₂}
      , dlist.split_right aa₁ (dlist.append bb₁ bb₂)
         = bb₂
| aa₁ aa₂ bb₁ bb₂
:= begin
     induction aa₁ with a aa₁ rec,
     { cases bb₁ with a b aa₁ bb₁, trivial },
     { cases bb₁ with a b aa₁ bb₁,
       apply rec
     }
   end

/-! #brief Splitting a map.
-/
theorem dlist.split_left_map {A : Type ℓ₁} {B₁ B₂ : A → Sort ℓ₂} (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa₁ aa₂ : list A}
        {bb : dlist B₁ (aa₁ ++ aa₂)}
      , dlist.split_left aa₁ (dlist.map @f bb) = dlist.map @f (dlist.split_left aa₁ bb)
| aa₁ aa₂ bb
:= begin
     induction aa₁ with a aa₁ rec,
     { trivial },
     { cases bb with a b aa₁ bb',
       apply dlist.eq,
       { trivial },
       { apply rec }
     }
   end

/-! #brief Splitting a map.
-/
theorem dlist.split_right_map {A : Type ℓ₁} {B₁ B₂ : A → Sort ℓ₂} (f : ∀ {a : A}, B₁ a → B₂ a)
    : ∀ {aa₁ aa₂ : list A}
        {bb : dlist B₁ (aa₁ ++ aa₂)}
      , dlist.split_right aa₁ (dlist.map @f bb) = dlist.map @f (dlist.split_right aa₁ bb)
| aa₁ aa₂ bb
:= begin
     induction aa₁ with a aa₁ rec,
     { trivial },
     { cases bb with a b aa₁ bb',
       apply rec
     }
   end

/-! #brief Getting out of an append.
-/
theorem dlist.get_append {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb₁ : dlist B aa₁} {bb₂ : dlist B aa₂}
        {n : ℕ} {ωn : n < list.length aa₁}
      , dlist.get (dlist.append bb₁ bb₂) (fin.mk n (list.length.grow_left ωn))
         == dlist.get bb₁ (fin.mk n ωn)
| aa₁ aa₂ bb₁ bb₂ n ωn
:= sorry

/-! #brief Getting out of a split.
-/
theorem dlist.get_split_left {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb : dlist B (aa₁ ++ aa₂)}
        {n : ℕ} {ωn : n < list.length aa₁}
      , dlist.get (dlist.split_left aa₁ bb) (fin.mk n ωn)
         == dlist.get bb (fin.mk n (list.length.grow_left ωn))
:= λ aa₁ aa₂ bb n ωn
   , sorry

/-! #brief Getting out of a split.
-/
theorem dlist.get_split_right {A : Type ℓ₁} {B : A → Sort ℓ₂}
    : ∀ {aa₁ aa₂ : list A}
        {bb : dlist B (aa₁ ++ aa₂)}
        {n : ℕ} {ωn : n < list.length aa₂}
      , dlist.get (dlist.split_right aa₁ bb) (fin.mk n ωn)
         == dlist.get bb (fin.mk (n + list.length aa₁) (list.length.grow_right ωn))
:= λ aa₁ aa₂ bb n ωn
   , sorry

/-! #brief Repeating an item as a dlist.
-/
definition dlist.repeat {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {a : A} (b : B a)
    : ∀ (N : ℕ)
      , dlist B (list.repeat a N)
| 0 := dlist.nil B
| (nat.succ n) := dlist.cons a b (list.repeat a n) (dlist.repeat n)

/-! #brief Action of get on repeat.
-/
theorem dlist.get_repeat {A : Type ℓ₁} {B : A → Sort ℓ₂}
    {a : A} {b : B a}
    : ∀ {N : ℕ} {n : fin N}
      , dlist.get (dlist.repeat b N) (fin.mk n^.val begin rw list.length_repeat, exact n^.is_lt end)
         == b
| 0 n := fin.zero_elim n
| (nat.succ N) (fin.mk 0 ω0) := heq.refl _
| (nat.succ N) (fin.mk (nat.succ n) ωn) := @dlist.get_repeat N (fin.mk n (nat.le_of_lt_succ ωn))

end stdaux
end qp


/-
Copyright (c) 2021 Paula Neeley. All rights reserved.
Author: Paula Neeley
Following the textbook "Dynamic Epistemic Logic" by
Hans van Ditmarsch, Wiebe van der Hoek, and Barteld Kooi
-/

import del.languageDEL del.syntax.syntaxDEL data.set.basic
local attribute [instance] classical.prop_decidable

variables {agents : Type}
open prfS5

---------------------- Helper Lemmas ----------------------

namespace S5lemma

lemma iden {Γ : ctx agents} {φ : form agents} :
  prfS5 Γ (φ ⊃ φ) :=
begin
exact mp (mp (@pl2 _ _ φ (φ ⊃ φ) φ) pl1) pl1
end

lemma prtrue {Γ : ctx agents} : prfS5 Γ ¬⊥ := iden

lemma weak {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ φ → prfS5 (Γ ∪ ψ) φ :=
begin
intro h,
induction h,
{apply ax, exact (set.mem_insert_of_mem _ h_h)},
{exact pl1},
{exact pl2},
{exact pl3},
{exact pl4},
{exact pl5},
{exact pl6},
{exact pl7},
{exact kdist},
{exact truth},
{exact posintro},
{exact negintro},
{apply mp,
  {exact h_ih_hpq},
  {exact h_ih_hp}},
{exact nec h_ih}
end

lemma pr {Γ : ctx agents} {φ : form agents} :
  prfS5 (Γ ∪ φ) φ :=
begin
apply ax;
apply or.intro_left;
simp
end

lemma cut {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ (φ ⊃ ψ) → prfS5 Γ (ψ ⊃ χ) → prfS5 Γ (φ ⊃ χ) :=
begin
intros h1 h2,
exact mp (mp pl2 (mp pl1 h2)) h1
end

lemma conv_deduction {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ (φ ⊃ ψ) → prfS5 (Γ ∪ φ) ψ :=
begin
intro h,
exact mp (weak h) pr
end

lemma hs1 {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ ((ψ ⊃ χ) ⊃ ((φ ⊃ ψ) ⊃ (φ ⊃ χ))) :=
begin
exact (mp (mp pl2 (mp pl1 pl2)) pl1)
end

lemma likemp {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ (φ ⊃ ((φ ⊃ ψ) ⊃ ψ)) :=
begin
exact (mp (mp hs1 (mp pl2 iden)) pl1)
end

lemma dne {Γ : ctx agents} {φ : form agents} :
prfS5 Γ ((¬¬φ) ⊃ φ) :=
begin
have h1 : prfS5 Γ (φ ⊃ (φ ⊃ φ)), from pl1,
exact (cut (cut pl1 (cut pl7 pl7)) (mp likemp h1))
end

lemma dni {Γ : ctx agents} {φ : form agents} : prfS5 Γ (φ ⊃ ¬¬φ) :=
begin
exact mp pl7 dne
end

lemma imp_if_imp_imp {Γ : ctx agents} {φ ψ χ : form agents} : prfS5 Γ (φ ⊃ χ) → prfS5 Γ (φ ⊃ (ψ ⊃ χ)) :=
begin
intro h1,
exact mp (mp pl2 (mp pl1 pl1)) h1
end

lemma cut1 {Γ : ctx agents} {φ ψ χ θ : form agents} :
  prfS5 Γ (θ ⊃ (φ ⊃ ψ)) → prfS5 Γ (ψ ⊃ χ) → prfS5 Γ (θ ⊃ (φ ⊃ χ)) :=
begin
intros h1 h2,
exact (cut h1) (mp pl2 (mp pl1 h2))
end

lemma imp_switch {Γ : ctx agents} {φ ψ χ : form agents} : prfS5 Γ (φ ⊃ (ψ ⊃ χ)) → prfS5 Γ (ψ ⊃ (φ ⊃ χ)) :=
begin
intro h1,
exact mp (mp pl2 (mp pl1 (mp pl2 h1))) pl1
end

lemma l2 {Γ : ctx agents} {φ ψ χ : form agents} : prfS5 Γ ((φ ⊃ (ψ ⊃ χ)) ⊃ (ψ ⊃ (φ ⊃ χ))) :=
begin
exact (mp (mp pl2 (cut pl2 hs1)) (mp pl1 pl1))
end

lemma hs2 {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ ((φ ⊃ ψ) ⊃ ((ψ ⊃ χ) ⊃ (φ ⊃ χ))) :=
begin
exact (mp l2 hs1)
end

lemma cut2 {Γ : ctx agents} {φ ψ χ θ : form agents} :
  prfS5 Γ (φ ⊃ ψ) → prfS5 Γ (θ ⊃ (ψ ⊃ χ)) → prfS5 Γ (θ ⊃ (φ ⊃ χ)) :=
begin
intros h1 h2,
exact imp_switch (cut h1 (imp_switch h2))
end

lemma double_imp {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ ((φ ⊃ (φ ⊃ ψ)) ⊃ (φ ⊃ ψ)) :=
begin
exact mp pl2 (imp_switch iden)
end

lemma imp_imp_iff_imp {Γ : ctx agents} {θ φ ψ : form agents} :
  prfS5 Γ (θ ⊃ (φ ⊃ (φ ⊃ ψ))) ↔ prfS5 Γ (θ ⊃ (φ ⊃ ψ)) :=
begin
split,
{intro h1,
exact cut h1 double_imp},
{intro h1,
exact cut h1 pl1}
end

lemma imp_shift {Γ : ctx agents} {θ φ ψ χ : form agents} :
  prfS5 Γ (θ ⊃ (φ ⊃ (ψ ⊃ χ))) ↔ prfS5 Γ (θ ⊃ (ψ ⊃ (φ ⊃ χ))) :=
begin
split,
repeat {intro h1, exact cut h1 (cut2 pl1 pl2)}
end

lemma left_and_imp {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ (ψ ⊃ ((φ & ψ) ⊃ χ)) → prfS5 Γ ((φ & ψ) ⊃ χ) :=
begin
intro h1,
exact mp double_imp (cut pl6 h1)
end

lemma and_right_imp {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ ((φ & ψ) ⊃ χ) ↔ prfS5 Γ (ψ ⊃ (φ ⊃ χ)) :=
begin
split,
{intro h1,
exact mp (cut2 pl1 pl2) (cut1 pl4 h1)},
intro h1,
exact left_and_imp (cut2 pl5 h1)
end

lemma not_and_subst {φ ψ χ : form agents} {Γ : ctx agents} : prfS5 Γ (φ ↔ ψ) → (prfS5 Γ ¬(χ & φ) ↔ prfS5 Γ ¬(χ & ψ)) :=
begin
intro h1, split,
{intro h2,
exact mp (mp pl3 (mp pl1 h2)) (cut dne (mp double_imp (cut2 (cut pl6 (mp pl6 h1)) (cut pl5 pl4))))},
{intro h2,
exact mp (mp pl3 (mp pl1 h2)) (cut dne (mp double_imp (cut2 (cut pl6 (mp pl5 h1)) (cut pl5 pl4))))},
end

lemma not_contra {Γ : ctx agents} {φ : form agents} :
  prfS5 Γ ¬(φ & ¬φ) :=
begin
exact mp (mp pl3 (cut dne pl6)) (cut dne pl5)
end

lemma phi_and_true {Γ : ctx agents} {φ : form agents} : prfS5 Γ ((φ&(¬⊥)) ↔ φ) :=
begin
exact (mp (mp pl4 pl5) (mp (imp_switch pl4) prtrue))
end

lemma imp_and_and_imp {Γ : ctx agents} {φ ψ χ θ : form agents} :
  prfS5 Γ (((φ ⊃ ψ) & (χ ⊃ θ))) → prfS5 Γ (((φ & χ) ⊃ (ψ & θ))) :=
begin
intro h,
exact (mp double_imp (cut (cut pl5 (mp pl5 h)) (cut2 (cut pl6 (mp pl6 h)) pl4)))
end

lemma not_contra_equiv_true {Γ : ctx agents} {φ : form agents} :
  prfS5 Γ (¬(φ & ¬φ) ↔ ¬⊥) :=
begin
exact (mp (mp pl4 (mp pl1 prtrue)) (mp pl1 not_contra))
end

lemma contrapos {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ ((¬ψ) ⊃ (¬φ)) ↔ prfS5 Γ (φ ⊃ ψ) :=
begin
split,
intro h1,
exact mp pl7 h1,
intro h1,
exact mp (cut (cut (mp hs1 dni) (mp hs2 dne)) pl7) h1,
end

lemma iff_not {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ (φ ↔ ψ) → prfS5 Γ (¬ψ ↔ ¬φ) :=
begin
intro h1,
have h2 : prfS5 Γ (φ ⊃ ψ), from mp pl5 h1,
have h3 : prfS5 Γ (ψ ⊃ φ), from mp pl6 h1,
rw ←contrapos at h2,
rw ←contrapos at h3,
exact (mp (mp pl4 h2) h3)
end

lemma contra_equiv_false {Γ : ctx agents} {φ : form agents} :
  prfS5 Γ ((φ & ¬φ) ↔ ⊥) :=
begin
have h1 := iff_not not_contra_equiv_true,
exact (mp (mp pl4 (cut dni (cut (mp pl6 h1) dne))) (cut dni (cut (mp pl5 h1) dne)))
end

lemma and_switch {Γ : ctx agents} {φ ψ : form agents} : prfS5 Γ ((φ & ψ) ↔ (ψ & φ)) :=
begin
exact (mp (mp pl4 (mp double_imp (cut pl5 (imp_switch (cut pl6 pl4)))))
(mp double_imp (cut pl5 (imp_switch (cut pl6 pl4)))))
end

lemma imp_and_imp {Γ : ctx agents} {φ ψ χ : form agents} :
  prfS5 Γ (φ ⊃ ψ) → prfS5 Γ  ((χ & φ) ⊃ (χ & ψ)) :=
begin
intros h1,
exact imp_and_and_imp (mp (mp pl4 iden) h1)
end

lemma iff_iff_and_iff {Γ : ctx agents} {φ ψ χ θ : form agents} :
  prfS5 Γ (φ ↔ χ) → prfS5 Γ (ψ ↔ θ) → prfS5 Γ ((φ & ψ) ↔ (χ & θ)) :=
begin
intros h1 h2,
exact mp (mp pl4 (imp_and_and_imp (mp (mp pl4 (mp pl5 h1)) (mp pl5 h2))))
  (imp_and_and_imp (mp (mp pl4 (mp pl6 h1)) (mp pl6 h2)))
end

lemma and_commute {Γ : ctx agents} {φ ψ χ : form agents} : prfS5 Γ (((φ & ψ) & χ) ↔ (φ & (ψ & χ))) :=
begin
exact mp (mp pl4 (mp double_imp (imp_imp_iff_imp.mp
  (cut (cut pl5 pl6) (cut2 pl6 (cut1 pl4 (imp_switch (cut (cut pl5 pl5) pl4))))))))
  (mp double_imp (imp_imp_iff_imp.mp (cut (cut pl6 pl5)
  (imp_switch (cut pl5 (cut1 pl4 (cut2 (cut pl6 pl6) pl4)))))))
end

lemma demorgans {Γ : ctx agents} {φ ψ : form agents} :
  prfS5 Γ (¬(φ & ψ)) ↔ prfS5 Γ (φ ⊃ ¬ψ) :=
begin
split,
intro h1,
exact (and_right_imp.mp (mp (contrapos.mpr (mp pl5 and_switch)) h1)),
intro h1,
exact (mp (contrapos.mpr (mp pl5 and_switch)) (and_right_imp.mpr h1))
end

lemma explosion {Γ : ctx agents} {ψ : form agents} : prfS5 Γ (⊥ ⊃ ψ) :=
begin
apply contrapos.mp, exact (mp pl1 iden)
end

lemma exfalso {Γ : ctx agents} {φ ψ : form agents} : prfS5 Γ ((φ & ¬φ) ⊃ ψ) :=
begin
exact cut not_contra explosion
end

lemma box_dn {Γ : ctx agents} {φ : form agents} {a : agents}  : prfS5 Γ ((¬K a φ) ↔ ¬(K a (¬¬φ))) :=
begin
exact mp (mp pl4 (contrapos.mpr (mp kdist (nec dne)))) (contrapos.mpr (mp kdist (nec dni)))
end

lemma dual_equiv1 {Γ : ctx agents} {φ : form agents} {a : agents} : prfS5 Γ ((K a φ) ↔ (¬(¬K a ¬(¬φ)))) :=
begin
exact mp (mp pl4 (cut (contrapos.mp (mp pl6 box_dn)) dni))
  (cut dne (contrapos.mp (mp pl5 box_dn)))
end

end S5lemma


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Yury Kudryashov
-/
import algebra.hom.group

/-!
# Extensionality lemmas for monoid and group structures

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

In this file we prove extensionality lemmas for `monoid` and higher algebraic structures with one
binary operation. Extensionality lemmas for structures that are lower in the hierarchy can be found
in `algebra.group.defs`.

## Implementation details

To get equality of `npow` etc, we define a monoid homomorphism between two monoid structures on the
same type, then apply lemmas like `monoid_hom.map_div`, `monoid_hom.map_pow` etc.

## Tags
monoid, group, extensionality
-/

universe u

@[ext, to_additive]
lemma monoid.ext {M : Type u} ⦃m₁ m₂ : monoid M⦄ (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
begin
  have h₁ : (@monoid.to_mul_one_class _ m₁).one = (@monoid.to_mul_one_class _ m₂).one,
    from congr_arg (@mul_one_class.one M) (mul_one_class.ext h_mul),
  set f : @monoid_hom M M (@monoid.to_mul_one_class _ m₁) (@monoid.to_mul_one_class _ m₂) :=
    { to_fun := id, map_one' := h₁, map_mul' := λ x y, congr_fun (congr_fun h_mul x) y },
  have hpow : m₁.npow = m₂.npow, by { ext n x, exact @monoid_hom.map_pow M M m₁ m₂ f x n },
  unfreezingI { cases m₁, cases m₂ },
  congr; assumption
end

@[to_additive]
lemma comm_monoid.to_monoid_injective {M : Type u} :
  function.injective (@comm_monoid.to_monoid M) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  congr'; injection h,
end

@[ext, to_additive]
lemma comm_monoid.ext {M : Type*} ⦃m₁ m₂ : comm_monoid M⦄ (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
comm_monoid.to_monoid_injective $ monoid.ext h_mul

@[to_additive]
lemma left_cancel_monoid.to_monoid_injective {M : Type u} :
  function.injective (@left_cancel_monoid.to_monoid M) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  congr'; injection h,
end

@[ext, to_additive]
lemma left_cancel_monoid.ext {M : Type u} ⦃m₁ m₂ : left_cancel_monoid M⦄
  (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
left_cancel_monoid.to_monoid_injective $ monoid.ext h_mul

@[to_additive]
lemma right_cancel_monoid.to_monoid_injective {M : Type u} :
  function.injective (@right_cancel_monoid.to_monoid M) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  congr'; injection h,
end

@[ext, to_additive]
lemma right_cancel_monoid.ext {M : Type u} ⦃m₁ m₂ : right_cancel_monoid M⦄
  (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
right_cancel_monoid.to_monoid_injective $ monoid.ext h_mul

@[to_additive]
lemma cancel_monoid.to_left_cancel_monoid_injective {M : Type u} :
  function.injective (@cancel_monoid.to_left_cancel_monoid M) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  congr'; injection h,
end

@[ext, to_additive]
lemma cancel_monoid.ext {M : Type*} ⦃m₁ m₂ : cancel_monoid M⦄
  (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
cancel_monoid.to_left_cancel_monoid_injective $ left_cancel_monoid.ext h_mul

@[to_additive]
lemma cancel_comm_monoid.to_comm_monoid_injective {M : Type u} :
  function.injective (@cancel_comm_monoid.to_comm_monoid M) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  congr'; injection h,
end

@[ext, to_additive]
lemma cancel_comm_monoid.ext {M : Type*} ⦃m₁ m₂ : cancel_comm_monoid M⦄
  (h_mul : m₁.mul = m₂.mul) : m₁ = m₂ :=
cancel_comm_monoid.to_comm_monoid_injective $ comm_monoid.ext h_mul

@[ext, to_additive]
lemma div_inv_monoid.ext {M : Type*} ⦃m₁ m₂ : div_inv_monoid M⦄ (h_mul : m₁.mul = m₂.mul)
  (h_inv : m₁.inv = m₂.inv) : m₁ = m₂ :=
begin
  have h₁ : (@div_inv_monoid.to_monoid _ m₁).one = (@div_inv_monoid.to_monoid _ m₂).one,
    from congr_arg (@monoid.one M) (monoid.ext h_mul),
  set f : @monoid_hom M M (by letI := m₁; apply_instance) (by letI := m₂; apply_instance) :=
    { to_fun := id, map_one' := h₁, map_mul' := λ x y, congr_fun (congr_fun h_mul x) y },
  have hpow : (@div_inv_monoid.to_monoid _ m₁).npow = (@div_inv_monoid.to_monoid _ m₂).npow :=
    congr_arg (@monoid.npow M) (monoid.ext h_mul),
  have hzpow : m₁.zpow = m₂.zpow,
  { ext m x,
    exact @monoid_hom.map_zpow' M M m₁ m₂ f (congr_fun h_inv) x m },
  have hdiv : m₁.div = m₂.div,
  { ext a b,
    exact @map_div' M M _ m₁ m₂ _ f (congr_fun h_inv) a b },
  unfreezingI { cases m₁, cases m₂ },
  congr, exacts [h_mul, h₁, hpow, h_inv, hdiv, hzpow]
end

@[ext, to_additive]
lemma group.ext {G : Type*} ⦃g₁ g₂ : group G⦄ (h_mul : g₁.mul = g₂.mul) : g₁ = g₂ :=
begin
  set f := @monoid_hom.mk' G G (by letI := g₁; apply_instance) g₂ id
    (λ a b, congr_fun (congr_fun h_mul a) b),
  exact group.to_div_inv_monoid_injective (div_inv_monoid.ext h_mul
    (funext $ @monoid_hom.map_inv G G g₁ (@group.to_division_monoid _ g₂) f))
end

@[ext, to_additive]
lemma comm_group.ext {G : Type*} ⦃g₁ g₂ : comm_group G⦄
  (h_mul : g₁.mul = g₂.mul) : g₁ = g₂ :=
comm_group.to_group_injective $ group.ext h_mul


lemma maze (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
    have q := h(p),
    have t := j(q),
    have u := l(t),
    exact u,
end


import Lean
import Advent.List

class QueueData (α : Type u) where
  init: List α
  tail: List α

namespace QueueData
def toList (q: QueueData α): List α := q.init ++ q.tail.reverse

def send (q: QueueData α) (a: α): QueueData α := {q with tail := a :: q.tail}

def pull (q: QueueData α) : Option (α × QueueData α) :=
  match q.init with
  | x :: xs  => some (x, ⟨xs, tail⟩)
  | [] => match q.tail.reverse with
    | x :: xs => some (x, ⟨xs, []⟩)
    | []      => none

def isEmpty (q: QueueData α) : Bool :=
  q.init.isEmpty && q.tail.isEmpty

def rel (a b : QueueData α): Prop := a.toList = b.toList

theorem nonEmptyAppend {xs ys: List α} {x: α} (p: xs ++ (x :: ys) = []) : False :=
  by cases xs <;> simp at p

theorem isEmptyToList (q: QueueData α): q.isEmpty <-> q.toList = [] := by
  simp [isEmpty, toList, List.isEmpty]
  cases q.init <;> cases q.tail <;> simp
  case cons h t =>
  simp
  intro p
  apply nonEmptyAppend p

theorem emptyPull {q: QueueData α}: q.toList = [] <-> q.pull = none := by
  simp [toList, pull]
  cases q.init <;> cases q.tail <;> simp
  case cons h t =>
  constructor
  generalize t.reverse = rt
  . intro q
    let u := nonEmptyAppend q
    contradiction
  . generalize up: List.reverse t ++ [h] = u
    intro q
    cases u <;> simp at q <;> simp

theorem nonEmptyPull {q: QueueData α} {x : α} {xs: List α}:
  q.toList = x :: xs  <-> (exists (qt: QueueData α), qt.toList = xs ∧ q.pull = some (x, qt)) := by
  simp [toList, pull]
  cases q.init
  generalize p : q.tail.reverse = tr
  . cases tr <;> simp
    . intro e
      cases e
      assumption
    . case cons h t =>
      constructor
      . intro p1
        exists ⟨ t , []⟩
        simp [*]
      . intro qe
        cases qe with | intro qt p1 =>
        cases qt with | mk qi qt =>
        simp [*]
        let p2 := p1.right.right
        simp at p1
        let p3 := congrArg (·.init) p2
        let p4 := congrArg (·.tail) p2
        simp at p3 p4
        rw [← p3, ← p4] at p1
        simp at p1
        simp [p1]

  . case cons h t =>
    simp
    constructor
    . intro pp
      let qt: QueueData α := ⟨ t, q.tail ⟩
      exists qt
      simp
      rw [pp.left, pp.right]
      simp
    . intro qe
      cases qe with | intro qt pp =>
      cases pp with | intro p1 p2 =>
      cases p2 with | intro p2 p3 =>
      cases qt with | mk qti qtt =>
      rw [p2, ← p1]
      simp
      let p4 := congrArg (·.init) p3
      let p5 := congrArg (·.tail) p3
      simp at p4 p5
      rw [p4, p5]

end QueueData

def EqvSetoid {α : Type u} (f: α -> β): Setoid α := {
  r := λ x y => f x = f y
  iseqv := {
    refl := by simp [QueueData.rel]
    symm := by intros _ _ p; simp [QueueData.rel]; rw [p]
    trans := by intros _ _ _ p q; simp [QueueData.rel]; rw [p, q]
  }
}

def QueueIsEqualUnderToList (α : Type u): Setoid (QueueData α) := EqvSetoid <| QueueData.toList

def Queue (α : Type u) := Quotient (QueueIsEqualUnderToList α)

namespace Queue

variable (q: Queue α)

def toList: List α :=
  q.lift (·.toList) <| by intros; assumption

def send (x: α): Queue α :=
  q.lift (fun qd => Quot.mk _ (qd.send x)) <| by
    simp [HasEquiv.Equiv]
    unfold Setoid.r
    intros a b p
    cases a; case mk ia ta =>
    cases b; case mk ib tb =>
    simp [QueueData.send]
    apply Quot.sound
    simp [QueueIsEqualUnderToList, EqvSetoid, QueueData.rel, QueueData.toList]
    repeat rw [← List.append_assoc]
    simp [QueueIsEqualUnderToList, EqvSetoid, QueueData.rel, QueueData.toList] at p
    rw [p]

def pull: Option (α × Queue α) :=
  q.lift (fun qd => qd.pull.map (fun (a, xs) => (a, Quot.mk _ xs))) <| by
  intros a b p
  simp
  generalize p1: a.isEmpty = aempty
  cases aempty
  . generalize p2 : a.toList = al
    cases al
    . rw [← QueueData.isEmptyToList, p1] at p2
      contradiction
    . case cons h t =>
      let p3 := p2
      rw [QueueData.nonEmptyPull] at p3
      rw [p, QueueData.nonEmptyPull] at p2
      cases p3 with | intro bqa p5 =>
      cases p2 with | intro bqt p6 =>
      simp [p5, p6, Option.map]
      apply Quot.sound
      simp [QueueIsEqualUnderToList, EqvSetoid, QueueData.rel]
      rw [p5.left, p6.left]
  . rw [QueueData.isEmptyToList] at p1
    let p2 := p1
    rw [QueueData.emptyPull] at p2
    rw [p, QueueData.emptyPull] at p1
    rw [p1, p2]

def isEmpty: Bool :=
  q.lift (·.isEmpty) <| by
  intros a b p
  simp
  generalize pe: a.isEmpty = ae
  cases ae
  . generalize pl: a.toList = al
    cases al
    . rewrite [←QueueData.isEmptyToList] at pl
      rw [pe] at pl
      contradiction
    . rw [p] at pl
      generalize pe2: b.isEmpty = be
      cases be <;> simp
      rw [QueueData.isEmptyToList, pl] at pe2
      contradiction
  . rw [QueueData.isEmptyToList, p, ←QueueData.isEmptyToList] at pe
    rw [pe]

def empty: Queue α :=   Quot.mk _ ⟨[], []⟩

def peak: Option α := q.pull.map (·.1)

def tail: Queue α := (q.pull.map (·.2) ).getD empty

def sendMany [ForIn Id ρ α](xs: ρ) : Id (Queue α) := do
  let mut q := q
  for x in xs do
    q := q.send x
  return q

instance: Inhabited (Queue α) where
  default := empty

instance [ToString α]: ToString (Queue α) where
  toString q := "Queue" ++ q.toList.toString

instance [Lean.ToJson α]: Lean.ToJson (Queue α) where
  toJson q := Lean.ToJson.toJson q.toList

instance : ForIn m (Queue α) α where
  forIn q b f := q.toList.forIn b f

instance [BEq α] : BEq (Queue α) where
  beq xs ys := xs.toList == ys.toList

end Queue


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.group.inj_surj
import algebra.group.commute
import algebra.hom.equiv
import algebra.opposites
import data.int.cast.defs

/-!
# Group structures on the multiplicative and additive opposites
-/
universes u v
variables (α : Type u)

namespace mul_opposite

/-!
### Additive structures on `αᵐᵒᵖ`
-/

instance [add_semigroup α] : add_semigroup (αᵐᵒᵖ) :=
unop_injective.add_semigroup _ (λ x y, rfl)

instance [add_left_cancel_semigroup α] : add_left_cancel_semigroup αᵐᵒᵖ :=
unop_injective.add_left_cancel_semigroup _ (λ x y, rfl)

instance [add_right_cancel_semigroup α] : add_right_cancel_semigroup αᵐᵒᵖ :=
unop_injective.add_right_cancel_semigroup _ (λ x y, rfl)

instance [add_comm_semigroup α] : add_comm_semigroup αᵐᵒᵖ :=
unop_injective.add_comm_semigroup _ (λ x y, rfl)

instance [add_zero_class α] : add_zero_class αᵐᵒᵖ :=
unop_injective.add_zero_class _ rfl (λ x y, rfl)

instance [add_monoid α] : add_monoid αᵐᵒᵖ :=
unop_injective.add_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance [add_monoid_with_one α] : add_monoid_with_one αᵐᵒᵖ :=
{ nat_cast := λ n, op n,
  nat_cast_zero := show op ((0 : ℕ) : α) = 0, by simp,
  nat_cast_succ := show ∀ n, op ((n + 1 : ℕ) : α) = op (n : ℕ) + 1, by simp,
  .. mul_opposite.add_monoid α, .. mul_opposite.has_one α }

instance [add_comm_monoid α] : add_comm_monoid αᵐᵒᵖ :=
unop_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance [sub_neg_monoid α] : sub_neg_monoid αᵐᵒᵖ :=
unop_injective.sub_neg_monoid _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [add_group α] : add_group αᵐᵒᵖ :=
unop_injective.add_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [add_group_with_one α] : add_group_with_one αᵐᵒᵖ :=
{ int_cast := λ n, op n,
  int_cast_of_nat := λ n, show op ((n : ℤ) : α) = op n, by rw int.cast_coe_nat,
  int_cast_neg_succ_of_nat := λ n, show op _ = op (- unop (op ((n + 1 : ℕ) : α))),
    by erw [unop_op, int.cast_neg_succ_of_nat]; refl,
  .. mul_opposite.add_monoid_with_one α, .. mul_opposite.add_group α }

instance [add_comm_group α] : add_comm_group αᵐᵒᵖ :=
unop_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-!
### Multiplicative structures on `αᵐᵒᵖ`

We also generate additive structures on `αᵃᵒᵖ` using `to_additive`
-/

@[to_additive] instance [semigroup α] : semigroup αᵐᵒᵖ :=
{ mul_assoc := λ x y z, unop_injective $ eq.symm $ mul_assoc (unop z) (unop y) (unop x),
  .. mul_opposite.has_mul α }

@[to_additive] instance [right_cancel_semigroup α] : left_cancel_semigroup αᵐᵒᵖ :=
{ mul_left_cancel := λ x y z H, unop_injective $ mul_right_cancel $ op_injective H,
  .. mul_opposite.semigroup α }

@[to_additive] instance [left_cancel_semigroup α] : right_cancel_semigroup αᵐᵒᵖ :=
{ mul_right_cancel := λ x y z H, unop_injective $ mul_left_cancel $ op_injective H,
  .. mul_opposite.semigroup α }

@[to_additive] instance [comm_semigroup α] : comm_semigroup αᵐᵒᵖ :=
{ mul_comm := λ x y, unop_injective $ mul_comm (unop y) (unop x),
  .. mul_opposite.semigroup α }

@[to_additive] instance [mul_one_class α] : mul_one_class αᵐᵒᵖ :=
{ one_mul := λ x, unop_injective $ mul_one $ unop x,
  mul_one := λ x, unop_injective $ one_mul $ unop x,
  .. mul_opposite.has_mul α, .. mul_opposite.has_one α }

@[to_additive] instance [monoid α] : monoid αᵐᵒᵖ :=
{ npow := λ n x, op $ x.unop ^ n,
  npow_zero' := λ x, unop_injective $ monoid.npow_zero' x.unop,
  npow_succ' := λ n x, unop_injective $ pow_succ' x.unop n,
  .. mul_opposite.semigroup α, .. mul_opposite.mul_one_class α }

@[to_additive] instance [right_cancel_monoid α] : left_cancel_monoid αᵐᵒᵖ :=
{ .. mul_opposite.left_cancel_semigroup α, .. mul_opposite.monoid α }

@[to_additive] instance [left_cancel_monoid α] : right_cancel_monoid αᵐᵒᵖ :=
{ .. mul_opposite.right_cancel_semigroup α, .. mul_opposite.monoid α }

@[to_additive] instance [cancel_monoid α] : cancel_monoid αᵐᵒᵖ :=
{ .. mul_opposite.right_cancel_monoid α, .. mul_opposite.left_cancel_monoid α }

@[to_additive] instance [comm_monoid α] : comm_monoid αᵐᵒᵖ :=
{ .. mul_opposite.monoid α, .. mul_opposite.comm_semigroup α }

@[to_additive] instance [cancel_comm_monoid α] : cancel_comm_monoid αᵐᵒᵖ :=
{ .. mul_opposite.cancel_monoid α, .. mul_opposite.comm_monoid α }

@[to_additive add_opposite.sub_neg_monoid] instance [div_inv_monoid α] : div_inv_monoid αᵐᵒᵖ :=
{ zpow := λ n x, op $ x.unop ^ n,
  zpow_zero' := λ x, unop_injective $ div_inv_monoid.zpow_zero' x.unop,
  zpow_succ' := λ n x, unop_injective $
    by rw [unop_op, zpow_of_nat, zpow_of_nat, pow_succ', unop_mul, unop_op],
  zpow_neg' := λ z x, unop_injective $ div_inv_monoid.zpow_neg' z x.unop,
  .. mul_opposite.monoid α, .. mul_opposite.has_inv α }

@[to_additive add_opposite.subtraction_monoid] instance [division_monoid α] :
  division_monoid αᵐᵒᵖ :=
{ mul_inv_rev := λ a b, unop_injective $ mul_inv_rev _ _,
  inv_eq_of_mul := λ a b h, unop_injective $ inv_eq_of_mul_eq_one_left $ congr_arg unop h,
  .. mul_opposite.div_inv_monoid α, .. mul_opposite.has_involutive_inv α }

@[to_additive add_opposite.subtraction_comm_monoid] instance [division_comm_monoid α] :
  division_comm_monoid αᵐᵒᵖ :=
{ ..mul_opposite.division_monoid α, ..mul_opposite.comm_semigroup α }

@[to_additive] instance [group α] : group αᵐᵒᵖ :=
{ mul_left_inv := λ x, unop_injective $ mul_inv_self $ unop x,
  .. mul_opposite.div_inv_monoid α, }

@[to_additive] instance [comm_group α] : comm_group αᵐᵒᵖ :=
{ .. mul_opposite.group α, .. mul_opposite.comm_monoid α }

variable {α}

@[simp, to_additive] lemma unop_div [div_inv_monoid α] (x y : αᵐᵒᵖ) :
  unop (x / y) = (unop y)⁻¹ * unop x :=
rfl

@[simp, to_additive] lemma op_div [div_inv_monoid α] (x y : α) :
  op (x / y) = (op y)⁻¹ * op x :=
by simp [div_eq_mul_inv]

@[simp, to_additive] lemma semiconj_by_op [has_mul α] {a x y : α} :
  semiconj_by (op a) (op y) (op x) ↔ semiconj_by a x y :=
by simp only [semiconj_by, ← op_mul, op_inj, eq_comm]

@[simp, to_additive] lemma semiconj_by_unop [has_mul α] {a x y : αᵐᵒᵖ} :
  semiconj_by (unop a) (unop y) (unop x) ↔ semiconj_by a x y :=
by conv_rhs { rw [← op_unop a, ← op_unop x, ← op_unop y, semiconj_by_op] }

@[to_additive] lemma _root_.semiconj_by.op [has_mul α] {a x y : α} (h : semiconj_by a x y) :
  semiconj_by (op a) (op y) (op x) :=
semiconj_by_op.2 h

@[to_additive] lemma _root_.semiconj_by.unop [has_mul α] {a x y : αᵐᵒᵖ} (h : semiconj_by a x y) :
  semiconj_by (unop a) (unop y) (unop x) :=
semiconj_by_unop.2 h

@[to_additive] lemma _root_.commute.op [has_mul α] {x y : α} (h : commute x y) :
  commute (op x) (op y) := h.op

@[to_additive] lemma commute.unop [has_mul α] {x y : αᵐᵒᵖ} (h : commute x y) :
  commute (unop x) (unop y) := h.unop

@[simp, to_additive] lemma commute_op [has_mul α] {x y : α} :
  commute (op x) (op y) ↔ commute x y :=
semiconj_by_op

@[simp, to_additive] lemma commute_unop [has_mul α] {x y : αᵐᵒᵖ} :
  commute (unop x) (unop y) ↔ commute x y :=
semiconj_by_unop

/-- The function `mul_opposite.op` is an additive equivalence. -/
@[simps { fully_applied := ff, simp_rhs := tt }]
def op_add_equiv [has_add α] : α ≃+ αᵐᵒᵖ :=
{ map_add' := λ a b, rfl, .. op_equiv }

@[simp] lemma op_add_equiv_to_equiv [has_add α] :
  (op_add_equiv : α ≃+ αᵐᵒᵖ).to_equiv = op_equiv :=
rfl

end mul_opposite

/-!
### Multiplicative structures on `αᵃᵒᵖ`
-/

namespace add_opposite

instance [semigroup α] : semigroup (αᵃᵒᵖ) :=
unop_injective.semigroup _ (λ x y, rfl)

instance [left_cancel_semigroup α] : left_cancel_semigroup αᵃᵒᵖ :=
unop_injective.left_cancel_semigroup _ (λ x y, rfl)

instance [right_cancel_semigroup α] : right_cancel_semigroup αᵃᵒᵖ :=
unop_injective.right_cancel_semigroup _ (λ x y, rfl)

instance [comm_semigroup α] : comm_semigroup αᵃᵒᵖ :=
unop_injective.comm_semigroup _ (λ x y, rfl)

instance [mul_one_class α] : mul_one_class αᵃᵒᵖ :=
unop_injective.mul_one_class _ rfl (λ x y, rfl)

instance {β} [has_pow α β] : has_pow αᵃᵒᵖ β := { pow := λ a b, op (unop a ^ b) }

@[simp] lemma op_pow {β} [has_pow α β] (a : α) (b : β) : op (a ^ b) = op a ^ b := rfl
@[simp] lemma unop_pow {β} [has_pow α β] (a : αᵃᵒᵖ) (b : β) : unop (a ^ b) = unop a ^ b := rfl

instance [monoid α] : monoid αᵃᵒᵖ :=
unop_injective.monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance [comm_monoid α] : comm_monoid αᵃᵒᵖ :=
unop_injective.comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

instance [div_inv_monoid α] : div_inv_monoid αᵃᵒᵖ :=
unop_injective.div_inv_monoid _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [group α] : group αᵃᵒᵖ :=
unop_injective.group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance [comm_group α] : comm_group αᵃᵒᵖ :=
unop_injective.comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

variable {α}

/-- The function `add_opposite.op` is a multiplicative equivalence. -/
@[simps { fully_applied := ff, simp_rhs := tt }]
def op_mul_equiv [has_mul α] : α ≃* αᵃᵒᵖ :=
{ map_mul' := λ a b, rfl, .. op_equiv }

@[simp] lemma op_mul_equiv_to_equiv [has_mul α] :
  (op_mul_equiv : α ≃* αᵃᵒᵖ).to_equiv = op_equiv :=
rfl

end add_opposite

open mul_opposite

/-- Inversion on a group is a `mul_equiv` to the opposite group. When `G` is commutative, there is
`mul_equiv.inv`. -/
@[to_additive "Negation on an additive group is an `add_equiv` to the opposite group. When `G`
is commutative, there is `add_equiv.inv`.", simps { fully_applied := ff, simp_rhs := tt }]
def mul_equiv.inv' (G : Type*) [division_monoid G] : G ≃* Gᵐᵒᵖ :=
{ map_mul' := λ x y, unop_injective $ mul_inv_rev x y,
  .. (equiv.inv G).trans op_equiv }

/-- A semigroup homomorphism `f : M →ₙ* N` such that `f x` commutes with `f y` for all `x, y`
defines a semigroup homomorphism to `Nᵐᵒᵖ`. -/
@[to_additive "An additive semigroup homomorphism `f : add_hom M N` such that `f x` additively
commutes with `f y` for all `x, y` defines an additive semigroup homomorphism to `Sᵃᵒᵖ`.",
  simps {fully_applied := ff}]
def mul_hom.to_opposite {M N : Type*} [has_mul M] [has_mul N] (f : M →ₙ* N)
  (hf : ∀ x y, commute (f x) (f y)) : M →ₙ* Nᵐᵒᵖ :=
{ to_fun := mul_opposite.op ∘ f,
  map_mul' := λ x y, by simp [(hf x y).eq] }

/-- A semigroup homomorphism `f : M →ₙ* N` such that `f x` commutes with `f y` for all `x, y`
defines a semigroup homomorphism from `Mᵐᵒᵖ`. -/
@[to_additive "An additive semigroup homomorphism `f : add_hom M N` such that `f x` additively
commutes with `f y` for all `x`, `y` defines an additive semigroup homomorphism from `Mᵃᵒᵖ`.",
  simps {fully_applied := ff}]
def mul_hom.from_opposite {M N : Type*} [has_mul M] [has_mul N] (f : M →ₙ* N)
  (hf : ∀ x y, commute (f x) (f y)) : Mᵐᵒᵖ →ₙ* N :=
{ to_fun := f ∘ mul_opposite.unop,
  map_mul' := λ x y, (f.map_mul _ _).trans (hf _ _).eq }

/-- A monoid homomorphism `f : M →* N` such that `f x` commutes with `f y` for all `x, y` defines
a monoid homomorphism to `Nᵐᵒᵖ`. -/
@[to_additive "An additive monoid homomorphism `f : M →+ N` such that `f x` additively commutes
with `f y` for all `x, y` defines an additive monoid homomorphism to `Sᵃᵒᵖ`.",
  simps {fully_applied := ff}]
def monoid_hom.to_opposite {M N : Type*} [mul_one_class M] [mul_one_class N] (f : M →* N)
  (hf : ∀ x y, commute (f x) (f y)) : M →* Nᵐᵒᵖ :=
{ to_fun := mul_opposite.op ∘ f,
  map_one' := congr_arg op f.map_one,
  map_mul' := λ x y, by simp [(hf x y).eq] }

/-- A monoid homomorphism `f : M →* N` such that `f x` commutes with `f y` for all `x, y` defines
a monoid homomorphism from `Mᵐᵒᵖ`. -/
@[to_additive "An additive monoid homomorphism `f : M →+ N` such that `f x` additively commutes
with `f y` for all `x`, `y` defines an additive monoid homomorphism from `Mᵃᵒᵖ`.",
  simps {fully_applied := ff}]
def monoid_hom.from_opposite {M N : Type*} [mul_one_class M] [mul_one_class N] (f : M →* N)
  (hf : ∀ x y, commute (f x) (f y)) : Mᵐᵒᵖ →* N :=
{ to_fun := f ∘ mul_opposite.unop,
  map_one' := f.map_one,
  map_mul' := λ x y, (f.map_mul _ _).trans (hf _ _).eq }

/-- The units of the opposites are equivalent to the opposites of the units. -/
@[to_additive "The additive units of the additive opposites are equivalent to the additive opposites
of the additive units."]
def units.op_equiv {M} [monoid M] : (Mᵐᵒᵖ)ˣ ≃* (Mˣ)ᵐᵒᵖ :=
{ to_fun := λ u, op ⟨unop u, unop ↑(u⁻¹), op_injective u.4, op_injective u.3⟩,
  inv_fun := mul_opposite.rec $ λ u, ⟨op ↑(u), op ↑(u⁻¹), unop_injective $ u.4, unop_injective u.3⟩,
  map_mul' := λ x y, unop_injective $ units.ext $ rfl,
  left_inv := λ x, units.ext $ by simp,
  right_inv := λ x, unop_injective $ units.ext $ rfl }

@[simp, to_additive]
lemma units.coe_unop_op_equiv {M} [monoid M] (u : (Mᵐᵒᵖ)ˣ) :
  ((units.op_equiv u).unop : M) = unop (u : Mᵐᵒᵖ) :=
rfl

@[simp, to_additive]
lemma units.coe_op_equiv_symm {M} [monoid M] (u : (Mˣ)ᵐᵒᵖ) :
  (units.op_equiv.symm u : Mᵐᵒᵖ) = op (u.unop : M) :=
rfl

/-- A semigroup homomorphism `M →ₙ* N` can equivalently be viewed as a semigroup homomorphism
`Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[to_additive "An additive semigroup homomorphism `add_hom M N` can equivalently be viewed as an
additive semigroup homomorphism `add_hom Mᵃᵒᵖ Nᵃᵒᵖ`. This is the action of the (fully faithful)
`ᵃᵒᵖ`-functor on morphisms.", simps]
def mul_hom.op {M N} [has_mul M] [has_mul N] :
  (M →ₙ* N) ≃ (Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ) :=
{ to_fun    := λ f, { to_fun   := op ∘ f ∘ unop,
                      map_mul' := λ x y, unop_injective (f.map_mul y.unop x.unop) },
  inv_fun   := λ f, { to_fun   := unop ∘ f ∘ op,
                      map_mul' := λ x y, congr_arg unop (f.map_mul (op y) (op x)) },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext x, simp } }

/-- The 'unopposite' of a semigroup homomorphism `Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ`. Inverse to `mul_hom.op`. -/
@[simp, to_additive "The 'unopposite' of an additive semigroup homomorphism `Mᵃᵒᵖ →ₙ+ Nᵃᵒᵖ`. Inverse
to `add_hom.op`."]
def mul_hom.unop {M N} [has_mul M] [has_mul N] :
  (Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ) ≃ (M →ₙ* N) := mul_hom.op.symm

/-- An additive semigroup homomorphism `add_hom M N` can equivalently be viewed as an additive
homomorphism `add_hom Mᵐᵒᵖ Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on
morphisms. -/
@[simps]
def add_hom.mul_op {M N} [has_add M] [has_add N] :
  (add_hom M N) ≃ (add_hom Mᵐᵒᵖ Nᵐᵒᵖ) :=
{ to_fun    := λ f, { to_fun    := op ∘ f ∘ unop,
                      map_add'  := λ x y, unop_injective (f.map_add x.unop y.unop) },
  inv_fun   := λ f, { to_fun    := unop ∘ f ∘ op,
                      map_add'  := λ x y, congr_arg unop (f.map_add (op x) (op y)) },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext, simp } }

/-- The 'unopposite' of an additive semigroup hom `αᵐᵒᵖ →+ βᵐᵒᵖ`. Inverse to
`add_hom.mul_op`. -/
@[simp] def add_hom.mul_unop {α β} [has_add α] [has_add β] :
  (add_hom αᵐᵒᵖ βᵐᵒᵖ) ≃ (add_hom α β) := add_hom.mul_op.symm

/-- A monoid homomorphism `M →* N` can equivalently be viewed as a monoid homomorphism
`Mᵐᵒᵖ →* Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[to_additive "An additive monoid homomorphism `M →+ N` can equivalently be viewed as an
additive monoid homomorphism `Mᵃᵒᵖ →+ Nᵃᵒᵖ`. This is the action of the (fully faithful)
`ᵃᵒᵖ`-functor on morphisms.", simps]
def monoid_hom.op {M N} [mul_one_class M] [mul_one_class N] :
  (M →* N) ≃ (Mᵐᵒᵖ →* Nᵐᵒᵖ) :=
{ to_fun    := λ f, { to_fun   := op ∘ f ∘ unop,
                      map_one' := congr_arg op f.map_one,
                      map_mul' := λ x y, unop_injective (f.map_mul y.unop x.unop) },
  inv_fun   := λ f, { to_fun   := unop ∘ f ∘ op,
                      map_one' := congr_arg unop f.map_one,
                      map_mul' := λ x y, congr_arg unop (f.map_mul (op y) (op x)) },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext x, simp } }

/-- The 'unopposite' of a monoid homomorphism `Mᵐᵒᵖ →* Nᵐᵒᵖ`. Inverse to `monoid_hom.op`. -/
@[simp, to_additive "The 'unopposite' of an additive monoid homomorphism `Mᵃᵒᵖ →+ Nᵃᵒᵖ`. Inverse to
`add_monoid_hom.op`."]
def monoid_hom.unop {M N} [mul_one_class M] [mul_one_class N] :
  (Mᵐᵒᵖ →* Nᵐᵒᵖ) ≃ (M →* N) := monoid_hom.op.symm

/-- An additive homomorphism `M →+ N` can equivalently be viewed as an additive homomorphism
`Mᵐᵒᵖ →+ Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/
@[simps]
def add_monoid_hom.mul_op {M N} [add_zero_class M] [add_zero_class N] :
  (M →+ N) ≃ (Mᵐᵒᵖ →+ Nᵐᵒᵖ) :=
{ to_fun    := λ f, { to_fun    := op ∘ f ∘ unop,
                      map_zero' := unop_injective f.map_zero,
                      map_add'  := λ x y, unop_injective (f.map_add x.unop y.unop) },
  inv_fun   := λ f, { to_fun    := unop ∘ f ∘ op,
                      map_zero' := congr_arg unop f.map_zero,
                      map_add'  := λ x y, congr_arg unop (f.map_add (op x) (op y)) },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext, simp } }

/-- The 'unopposite' of an additive monoid hom `αᵐᵒᵖ →+ βᵐᵒᵖ`. Inverse to
`add_monoid_hom.mul_op`. -/
@[simp] def add_monoid_hom.mul_unop {α β} [add_zero_class α] [add_zero_class β] :
  (αᵐᵒᵖ →+ βᵐᵒᵖ) ≃ (α →+ β) := add_monoid_hom.mul_op.symm

/-- A iso `α ≃+ β` can equivalently be viewed as an iso `αᵐᵒᵖ ≃+ βᵐᵒᵖ`. -/
@[simps]
def add_equiv.mul_op {α β} [has_add α] [has_add β] :
  (α ≃+ β) ≃ (αᵐᵒᵖ ≃+ βᵐᵒᵖ) :=
{ to_fun    := λ f, op_add_equiv.symm.trans (f.trans op_add_equiv),
  inv_fun   := λ f, op_add_equiv.trans (f.trans op_add_equiv.symm),
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext, simp } }

/-- The 'unopposite' of an iso `αᵐᵒᵖ ≃+ βᵐᵒᵖ`. Inverse to `add_equiv.mul_op`. -/
@[simp] def add_equiv.mul_unop {α β} [has_add α] [has_add β] :
  (αᵐᵒᵖ ≃+ βᵐᵒᵖ) ≃ (α ≃+ β) := add_equiv.mul_op.symm

/-- A iso `α ≃* β` can equivalently be viewed as an iso `αᵐᵒᵖ ≃* βᵐᵒᵖ`. -/
@[to_additive "A iso `α ≃+ β` can equivalently be viewed as an iso `αᵃᵒᵖ ≃+ βᵃᵒᵖ`.", simps]
def mul_equiv.op {α β} [has_mul α] [has_mul β] :
  (α ≃* β) ≃ (αᵐᵒᵖ ≃* βᵐᵒᵖ) :=
{ to_fun    := λ f, { to_fun   := op ∘ f ∘ unop,
                      inv_fun  := op ∘ f.symm ∘ unop,
                      left_inv := λ x, unop_injective (f.symm_apply_apply x.unop),
                      right_inv := λ x, unop_injective (f.apply_symm_apply x.unop),
                      map_mul' := λ x y, unop_injective (f.map_mul y.unop x.unop) },
  inv_fun   := λ f, { to_fun   := unop ∘ f ∘ op,
                      inv_fun  := unop ∘ f.symm ∘ op,
                      left_inv := λ x, by simp,
                      right_inv := λ x, by simp,
                      map_mul' := λ x y, congr_arg unop (f.map_mul (op y) (op x)) },
  left_inv  := λ f, by { ext, refl },
  right_inv := λ f, by { ext, simp } }

/-- The 'unopposite' of an iso `αᵐᵒᵖ ≃* βᵐᵒᵖ`. Inverse to `mul_equiv.op`. -/
@[simp, to_additive "The 'unopposite' of an iso `αᵃᵒᵖ ≃+ βᵃᵒᵖ`. Inverse to `add_equiv.op`."]
def mul_equiv.unop {α β} [has_mul α] [has_mul β] :
  (αᵐᵒᵖ ≃* βᵐᵒᵖ) ≃ (α ≃* β) := mul_equiv.op.symm

section ext

/-- This ext lemma change equalities on `αᵐᵒᵖ →+ β` to equalities on `α →+ β`.
This is useful because there are often ext lemmas for specific `α`s that will apply
to an equality of `α →+ β` such as `finsupp.add_hom_ext'`. -/
@[ext]
lemma add_monoid_hom.mul_op_ext {α β} [add_zero_class α] [add_zero_class β]
  (f g : αᵐᵒᵖ →+ β)
  (h : f.comp (op_add_equiv : α ≃+ αᵐᵒᵖ).to_add_monoid_hom =
       g.comp (op_add_equiv : α ≃+ αᵐᵒᵖ).to_add_monoid_hom) : f = g :=
add_monoid_hom.ext $ mul_opposite.rec $ λ x, (add_monoid_hom.congr_fun h : _) x

end ext


/-
Copyright (c) 2021 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best
-/
-- Note: This is https://github.com/leanprover-community/flt-regular/blob/master/src/ring_theory/polynomial/homogenization.lean

import data.mv_polynomial.comm_ring
import data.set.finite
import ring_theory.polynomial.homogeneous
import ring_theory.polynomial.basic
import order.symm_diff
import tactic.omega
-- import home_finder

/-!
# Homogenization

## Main definitions

* `mv_polynomial.homogenization`

## Main statements

* foo_bar_unique

## Notation

## Implementation details

* We homogenize polynomials over a given ground set of variables, rather than adjoining an extra
  variable to give the user more choice in the type of the polynomials involved.

## References

* [F. Bar, *Quuxes*][]

## Tags

-/

variables {R ι : Type*} [comm_semiring R]

open polynomial finset mv_polynomial

open_locale big_operators
noncomputable theory
namespace mv_polynomial

section leading_terms
-- TODO is this the best def?
/-- The sum of the monomials of highest degree of a multivariate polynomial. -/
def leading_terms (p : mv_polynomial ι R) : mv_polynomial ι R :=
homogeneous_component p.total_degree p

lemma leading_terms_apply (p : mv_polynomial ι R) : p.leading_terms =
  ∑ d in p.support.filter (λ d, ∑ i in d.support, d i = p.total_degree), monomial d (coeff d p) :=
homogeneous_component_apply _ _
-- (p.support.filter (λ s : ι →₀ ℕ, s.sum (λ _ e, e) = p.total_degree)).sum $
--   λ s, monomial s (p.coeff s)

@[simp]
lemma leading_terms_zero : (0 : mv_polynomial ι R).leading_terms = 0 :=
by simp [leading_terms]

lemma finset.filter_eq_self_iff {α : Type*} (S : finset α) (h : α → Prop) [decidable_pred h] :
  S.filter h = S ↔ ∀ s ∈ S, h s :=
begin
  cases S,
  simp only [finset.filter, finset.mem_mk, multiset.filter_eq_self],
end

-- TODO for non-zero polys this is true that p.lead = p iff p.is_homogenous n for a fixed n
-- TODO generalize to p.homog comp = n
lemma leading_terms_eq_self_iff_is_homogeneous (p : mv_polynomial ι R) :
  p.leading_terms = p ↔ p.is_homogeneous p.total_degree :=
begin
  split; intro h,
  { rw is_homogeneous,
    contrapose! h,
    rcases h with ⟨h_w, h_h₁, h_h₂⟩,
    rw [leading_terms, ne.def, mv_polynomial.ext_iff],
    push_neg,
    use h_w,
    classical,
    change ¬ h_w.sum (λ (_x : ι) (e : ℕ), e) = p.total_degree at h_h₂,
    simp only [h_h₁.symm, coeff_homogeneous_component, exists_prop, and_true, ne.def, not_false_iff,
      not_forall, ite_eq_left_iff],
    convert h_h₂, },
  { rw [leading_terms_apply],
    rw (_ : p.support.filter (λ (s : ι →₀ ℕ), ∑ (i : ι) in s.support, s i = p.total_degree)
            = p.support),
    { rw support_sum_monomial_coeff p, },
    { rw finset.filter_eq_self_iff,
      intros s hs,
      rw [mem_support_iff] at hs,
      rw ← h hs, }, },
end

@[simp]
lemma leading_terms_C (r : R) : (C r : mv_polynomial ι R).leading_terms = C r :=
begin
  rw leading_terms_eq_self_iff_is_homogeneous,
  convert is_homogeneous_C _ _,
  simp,
end

lemma is_homogeneous_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.is_homogeneous p.total_degree :=
homogeneous_component_is_homogeneous (total_degree p) p

lemma exists_coeff_ne_zero_total_degree {p : mv_polynomial ι R} (hp : p ≠ 0) :
  ∃ (v : ι →₀ ℕ), v.sum (λ _ e, e) = p.total_degree ∧ p.coeff v ≠ 0 :=
begin
  obtain ⟨b, hb₁, hb₂⟩ := p.support.exists_mem_eq_sup (finsupp.support_nonempty_iff.mpr hp)
    (λ (m : ι →₀ ℕ), m.to_multiset.card),
  use b,
  split,
  { rw ← total_degree_eq p at hb₂,
    rw hb₂,
    dsimp, -- TODO break this out as a lemma
    funext m,
    exact (finsupp.card_to_multiset _).symm, },
  { exact mem_support_iff.mp hb₁, },
end

-- TODO mathlib
@[simp] lemma support_eq_empty {f : mv_polynomial ι R} : f.support = ∅ ↔ f = 0 :=
finsupp.support_eq_empty

lemma support_add_eq [decidable_eq ι] {g₁ g₂ : mv_polynomial ι R}
  (h : disjoint g₁.support g₂.support) : (g₁ + g₂).support = g₁.support ∪ g₂.support :=
finsupp.support_add_eq h

lemma support_sum_monomial_subset (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R) :
  support (∑ v in S, monomial v (f v)) ⊆ S :=
begin
  classical,
  induction S using finset.induction with s S hs hsi,
  { simp, },
  { rw finset.sum_insert hs,
    apply finset.subset.trans support_add,
    apply finset.union_subset,
    { apply finset.subset.trans support_monomial_subset (finset.subset_union_left _ S), },
    { apply finset.subset.trans hsi (finset.subset_insert _ _), }, },
end

lemma support_sum_monomial_eq [decidable_eq R] (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R) :
  support (∑ v in S, monomial v (f v)) = S.filter (λ v, f v ≠ 0) :=
begin
  letI := classical.dec_eq ι,
  induction S using finset.induction with s S hs hsi,
  { simp, },
  rw [finset.sum_insert hs, support_add_eq],
  { rw [hsi, filter_congr_decidable, filter_insert, support_monomial],
    split_ifs with h;
    { simp [h, insert_eq], }, },
  { apply disjoint_of_subset_left support_monomial_subset,
    apply disjoint_of_subset_right (support_sum_monomial_subset _ _),
    simp [support_sum_monomial_subset, hs], },
end

lemma sum_monomial_ne_zero_of_exists_mem_ne_zero (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R)
  (h : ∃ (s) (hs : s ∈ S), f s ≠ 0) : ∑ (s : ι →₀ ℕ) in S, monomial s (f s) ≠ 0 :=
begin
  classical,
  simp only [← support_eq_empty, support_sum_monomial_eq, filter_congr_decidable, ne.def],
  rcases h with ⟨s, h_S, h_s⟩,
  exact ne_empty_of_mem (mem_filter.mpr ⟨h_S, h_s⟩),
end

lemma leading_terms_ne_zero {p : mv_polynomial ι R} (hp : p ≠ 0) : p.leading_terms ≠ 0 :=
begin
  classical,
  rw leading_terms_apply,
  apply sum_monomial_ne_zero_of_exists_mem_ne_zero,
  simp only [exists_prop, mem_support_iff, finset.mem_filter],
  convert exists_coeff_ne_zero_total_degree hp,
  ext v,
  change v.sum (λ (_x : ι) (e : ℕ), e) with v.support.sum v,
  simp [and_comm],
end

@[simp]
lemma total_degree_homogenous_component_of_ne_zero {n : ℕ} {p : mv_polynomial ι R}
  (hp : homogeneous_component n p ≠ 0) :
  (homogeneous_component n p).total_degree = n :=
is_homogeneous.total_degree (homogeneous_component_is_homogeneous n p) hp

@[simp]
lemma total_degree_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.total_degree = p.total_degree :=
begin
  by_cases hp : p = 0,
  { simp [hp], },
  exact total_degree_homogenous_component_of_ne_zero (leading_terms_ne_zero hp),
end

-- TODO generalize this to homogeneous component idempotent?
lemma leading_terms_idempotent (p : mv_polynomial ι R) :
  p.leading_terms.leading_terms = p.leading_terms :=
begin
  rw [leading_terms_eq_self_iff_is_homogeneous, total_degree_leading_terms],
  exact is_homogeneous_leading_terms p,
end

lemma homogeneous_component_add (m  : ℕ) (p q : mv_polynomial ι R) :
  homogeneous_component m (p + q) = homogeneous_component m p + homogeneous_component m q :=
by rw [homogeneous_component, linear_map.comp_apply, linear_map.comp_apply, linear_map.comp_apply,
    linear_map.map_add, linear_map.map_add]

lemma coeff_leading_terms (p : mv_polynomial ι R) (d : ι →₀ ℕ) :
  coeff d p.leading_terms = if ∑ i in d.support, d i = p.total_degree then coeff d p else 0 :=
coeff_homogeneous_component _ _ _

lemma support_homogeneous_component (n : ℕ) (p : mv_polynomial ι R) :
  (homogeneous_component n p).support = p.support.filter (λ d, d.sum (λ _ m, m) = n) :=
begin
  rw homogeneous_component,
  simp only [finsupp.restrict_dom_apply, submodule.subtype_apply, function.comp_app,
    linear_map.coe_comp, set.mem_set_of_eq],
  erw ← finsupp.support_filter,
  refl,
end

lemma support_homogeneous_component_subset (n : ℕ) (p : mv_polynomial ι R) :
  (homogeneous_component n p).support ⊆ p.support :=
begin
  rw support_homogeneous_component,
  exact finset.filter_subset _ _,
end

lemma support_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.support = p.support.filter (λ d, d.sum (λ _ m, m) = p.total_degree) :=
support_homogeneous_component _ _

lemma support_leading_terms_subset (p : mv_polynomial ι R) : p.leading_terms.support ⊆ p.support :=
support_homogeneous_component_subset _ _

lemma eq_leading_terms_add (p : mv_polynomial ι R) (hp : p.total_degree ≠ 0) :
  ∃ p_rest : mv_polynomial ι R,
    p = p.leading_terms + p_rest ∧ p_rest.total_degree < p.total_degree :=
begin
  letI := classical.dec_eq ι,
  existsi (∑ (v : ι →₀ ℕ) in p.support \ p.leading_terms.support, (monomial v) (coeff v p)),
  split,
  { nth_rewrite 0 p.leading_terms.as_sum,
    have : ∀ (x : ι →₀ ℕ) (hx : x ∈ p.leading_terms.support), x.support.sum x = p.total_degree,
    { intros x hx,
      rw support_leading_terms at hx,
      simp at hx,
      exact hx.2, },
    simp_rw coeff_leading_terms,
    conv in (ite _ _ _)
    { rw [if_pos (this x H)], },
    have : p.leading_terms.support ⊆ p.support,
    from support_leading_terms_subset _,
    have : p.leading_terms.support ∩ p.support = p.leading_terms.support,
    { rw finset.inter_eq_left_iff_subset,
      exact this },
    nth_rewrite 0 ← this,
    rw [finset.inter_comm, finset.sum_inter_add_sum_diff],
    exact p.as_sum, },
  { rw [total_degree, finset.sup_lt_iff],
    intros b hb,
    rw support_leading_terms at hb,
    rw ← finset.filter_not at hb, -- TODO this was also hard to find maybe a negated version is good
    have := support_sum_monomial_subset _ _ hb,
    simp only [finset.mem_filter] at this,
    cases this,
    rw total_degree,
    exact lt_of_le_of_ne (finset.le_sup this_left) this_right,
    rw [bot_eq_zero],
    exact pos_iff_ne_zero.mpr hp, },
end

lemma finset.sup_eq_bot_iff {α β : Type*} [semilattice_sup β] [order_bot β] (f : α → β)
  (S : finset α) : S.sup f = ⊥ ↔ ∀ s ∈ S, f s = ⊥ :=
begin
  classical,
  induction S using finset.induction with a S haS hi,
  { simp, },
  simp [hi],
end

lemma leading_terms_add_of_total_degree_lt (p q : mv_polynomial ι R)
  (h : q.total_degree < p.total_degree) : (p + q).leading_terms = p.leading_terms :=
by rw [leading_terms, leading_terms, total_degree_add_eq_left_of_total_degree_lt h,
  homogeneous_component_add, homogeneous_component_eq_zero _ q h, add_zero]

lemma finsupp.support_smul_eq {α M R : Type*} [semiring R] [add_comm_monoid M] [module R M]
  [no_zero_smul_divisors R M] {b : R} (hb : b ≠ 0) {g : α →₀ M} :
  (b • g).support = g.support :=
begin
  ext a,
  simp [finsupp.smul_apply, mem_support_iff, ne.def, hb],
end

@[simp]
lemma leading_terms_C_mul [no_zero_smul_divisors R R] (p : mv_polynomial ι R) (r : R) :
  (C r * p).leading_terms = C r * p.leading_terms :=
begin
  by_cases hr : r = 0,
  { simp [hr], },
  have : (C r * p).support = p.support,
  { rw C_mul',
    exact finsupp.support_smul_eq hr, },
  rw [leading_terms, leading_terms, total_degree, this, homogeneous_component_C_mul],
  refl,
end

lemma eq_C_of_total_degree_zero {p : mv_polynomial ι R} (hp : p.total_degree = 0) :
  ∃ r : R, p = C r :=
begin
  letI := classical.dec_eq ι,
  erw finset.sup_eq_bot_iff at hp,
  simp only [mem_support_iff] at hp,
  use coeff 0 p,
  ext,
  by_cases hm : m = 0,
  { simp [hm], },
  rw [coeff_C, if_neg (ne.symm hm)],
  classical,
  by_contradiction h,
  specialize hp m h,
  apply hm,
  rw finsupp.sum at hp, -- TODO this and line below could be a lemma, finsupp.sum_eq_zero_iff?
  simp only [not_imp_self, bot_eq_zero, finsupp.mem_support_iff, finset.sum_eq_zero_iff] at hp,
  ext,
  simp [hp],
end

-- TODO can things be generalized to no_zero_divisors (would require an instance for mv_poly)
-- sadly this adds some imports and requirements not needed in rest of file
@[simp]
lemma leading_terms_mul {S : Type*} [comm_ring S] [is_domain S] (p q : mv_polynomial ι S) :
  (p * q).leading_terms = p.leading_terms * q.leading_terms :=
begin
  by_cases hp : p.total_degree = 0,
  { rcases eq_C_of_total_degree_zero hp with ⟨rp, rfl⟩,
    rw [leading_terms_C_mul, leading_terms_C], },
  by_cases hq : q.total_degree = 0,
  { rcases eq_C_of_total_degree_zero hq with ⟨rq, rfl⟩,
    rw [mul_comm, leading_terms_C_mul, leading_terms_C, mul_comm], },
  have : (p.leading_terms * q.leading_terms).total_degree = p.total_degree + q.total_degree,
  { rw is_homogeneous.total_degree,
    apply is_homogeneous.mul (is_homogeneous_leading_terms p) (is_homogeneous_leading_terms q),
    apply mul_ne_zero,
    { apply leading_terms_ne_zero, -- TODO maybe this can be a lemma ne_zero_of_total_degree_ne_zero
      intro hh,
      subst hh,
      simpa, },
    { apply leading_terms_ne_zero, -- TODO maybe this can be a lemma ne_zero_of_total_degree_ne_zero
      intro hh,
      subst hh,
      simpa, }, },
  rcases eq_leading_terms_add p hp with ⟨wp, hp, tp⟩,
  rw hp,
  rcases eq_leading_terms_add q hq with ⟨wq, hq, tq⟩,
  rw hq,
  simp only [add_mul, mul_add],
  rw [add_assoc, leading_terms_add_of_total_degree_lt, leading_terms_add_of_total_degree_lt,
    leading_terms_add_of_total_degree_lt, leading_terms_idempotent, leading_terms_idempotent,
    leading_terms_eq_self_iff_is_homogeneous],
  { convert is_homogeneous.mul (is_homogeneous_leading_terms _) (is_homogeneous_leading_terms _), },
  { rwa total_degree_leading_terms, },
  { rwa total_degree_leading_terms, },
  { rw this,
    calc _ ≤ max (wp * q.leading_terms).total_degree (p.leading_terms * wq + wp * wq).total_degree :
              total_degree_add _ _
       ... ≤ max (wp * q.leading_terms).total_degree
              (max (p.leading_terms * wq).total_degree (wp * wq).total_degree) :
                max_le_max (le_refl _) (total_degree_add _ _)
       ... ≤ max (wp.total_degree + q.leading_terms.total_degree)
              (max (p.leading_terms * wq).total_degree (wp * wq).total_degree) :
                max_le_max (total_degree_mul _ _) (le_refl _)
       ... ≤ max (wp.total_degree + q.leading_terms.total_degree)
              (max (p.leading_terms.total_degree + wq.total_degree)
                (wp.total_degree + wq.total_degree)) :
                  max_le_max (le_refl _) (max_le_max (total_degree_mul _ _) (total_degree_mul _ _))
       ... < p.total_degree + q.total_degree : _,
    simp only [total_degree_leading_terms, max_lt_iff, add_lt_add_iff_right, add_lt_add_iff_left],
    exact ⟨tp, tq, add_lt_add tp tq⟩, },
end

lemma total_degree_mul_eq {S : Type*} [comm_ring S] [is_domain S] {p q : mv_polynomial ι S}
  (hp : p ≠ 0) (hq : q ≠ 0) : (p * q).total_degree = p.total_degree + q.total_degree :=
begin
  rw [← total_degree_leading_terms, ← total_degree_leading_terms p, ← total_degree_leading_terms q,
    leading_terms_mul, is_homogeneous.total_degree],
  apply is_homogeneous.mul;
  simp [is_homogeneous_leading_terms],
  apply mul_ne_zero (leading_terms_ne_zero hp) (leading_terms_ne_zero hq),
end

end leading_terms

end mv_polynomial

namespace mv_polynomial
section

-- generalized version of the unprimed version
lemma support_sum_monomial_subset' [decidable_eq ι] {α : Type*} (S : finset α) (g : α → ι →₀ ℕ)
  (f : α → R) : support (∑ v in S, monomial (g v) (f v)) ⊆ S.image g :=
begin
  letI := classical.dec_eq α,
  induction S using finset.induction with s S hs hsi,
  { simp, },
  { rw finset.sum_insert hs,
    apply finset.subset.trans support_add,
    apply finset.union_subset,
    { apply finset.subset.trans support_monomial_subset _,
      rw finset.image_insert,
      convert finset.subset_union_left _ (finset.image g S), },
    { apply finset.subset.trans hsi _,
      rw finset.image_insert,
      exact finset.subset_insert (g s) (finset.image g S), }, },
end
open_locale pointwise

lemma support_mul' [decidable_eq ι] (p q : mv_polynomial ι R) :
  (p * q).support ⊆ p.support + q.support :=
begin
  -- TODO this was really hard to find, maybe needs a docstring or alias?
  rw [p.as_sum, q.as_sum, finset.sum_mul_sum],
  simp_rw [monomial_mul],
  rw [support_sum_monomial_coeff, support_sum_monomial_coeff],
  exact finset.subset.trans (support_sum_monomial_subset' _ _ _) (finset.subset.refl _),
end

end

end mv_polynomial