import combinatorics.quiver.basic
import algebra.group.basic
import algebra.hom.group

universes u v w

/-
Random thoughts:

* A graph *à la Serre* with choice of orientation is really just a quiver, so we might as well work
  with quivers?
* A quiver has a freely generated associated groupoid:

  Quiver I -----> SerreGraph I
      \           /
       \         /
        \       /
         v     v
        Groupoid I

then what?

-/

class Serre (obj : Type u)
extends quiver.{v+1} obj : Type (max u (v+1)) :=
(ι       : Π X Y : obj, (X ⟶ Y) → (Y ⟶ X))
(ι_inv   : Π {X Y : obj} (e : X ⟶ Y), @ι Y X (@ι X Y e) = e)
(ι_nofix : Π {X : obj} (e : X ⟶ X), @ι X X e ≠ e)

def disorient {obj : Type u} (q : quiver.{v+1} obj) : quiver.{v+1} obj := ⟨λ X Y, (q.hom X Y) ⊕ (q.hom Y X)⟩

def disorient_ι {obj : Type u} (q : quiver.{v+1} obj) : ∀ {X Y}, (disorient q).hom X Y → (disorient q).hom Y X
| _ _ (sum.inl e) := sum.inr e
| _ _ (sum.inr e) := sum.inl e

lemma disorient_ι_nofix {obj : Type u} (q : quiver.{v+1} obj) :
  ∀ {X} (e : (disorient q).hom X X), (disorient_ι q) e ≠ e
| _ (sum.inl e) := λ eq, sum.no_confusion eq
| _ (sum.inr e) := λ eq, sum.no_confusion eq

lemma disorient_ι_inv {obj : Type u} (q : quiver.{v+1} obj) :
  ∀ {X Y} (e : (disorient q).hom X Y), (disorient_ι q) ((disorient_ι q) e) = e
| _ _ (sum.inl e) := rfl
| _ _ (sum.inr e) := rfl

class GoG' (obj : Type u) extends quiver.{v+1} obj :=
  (vertex_carrier : Π X : obj, Type w)
  (edge_carrier : Π {X Y : obj} (e : X ⟶ Y), Type w)
  (vertex_group : Π X : obj, group (vertex_carrier X))
  (edge_group : Π {X Y : obj} (e : X ⟶ Y), group (edge_carrier e))
  (edge_start : Π {X Y : obj} (e : X ⟶ Y), edge_carrier e →* vertex_carrier X)
  (edge_start_inj : Π {X Y : obj} (e : X ⟶ Y), function.injective (edge_start e))
  (edge_end   : Π {X Y : obj} (e : X ⟶ Y), edge_carrier e →* vertex_carrier X)
  (edge_end_inj : Π {X Y : obj} (e : X ⟶ Y), function.injective (edge_end e))

class GoG (obj : Type u)
extends Serre obj :=
(vertex_carrier : Π X : obj, Type w)
(edge_carrier : Π {X Y : obj} (e : X ⟶ Y), Type w)
(vertex_group : Π X : obj, group (vertex_carrier X))
(edge_group : Π {X Y : obj} (e : X ⟶ Y), group (edge_carrier e))
(edge_start : Π {X Y : obj} (e : X ⟶ Y), edge_carrier e →* vertex_carrier X)
(edge_start_inj : Π {X Y : obj} (e : X ⟶ Y), function.injective (edge_start e))
(edge_ι : Π {X Y : obj} (e : X ⟶ Y), edge_carrier e →* edge_carrier (@ι X Y e))
(edge_ι_inv : Π {X Y : obj} (e : X ⟶ Y), by { let lol := ((edge_ι _).comp (edge_ι e)),
                                               have eee := ι_inv e, convert lol, } = @id (edge_carrier e)) -- doesn't work


import data.list.basic
open list
lemma foldr_ext {α : Type*} {β : Type*} {l : list α} (f f' : α → β → β) (s : β)
  (H : ∀ a ∈ l, ∀ b : β, f a b = f' a b) : foldr f s l = foldr f' s l :=
begin induction l with h l IH, {simp}, -- base case}
  simp *,
  suffices : foldr f s l = foldr f' s l,
    rw this,
  apply IH,
  intros a Ha,
  apply H,
  -- simp still no work
  simp * {contextual := tt} -- this work

end

lemma got_it (P Q R S : Prop) (IH : (P → R) → S) (H0 : P → Q) (H' : Q → R) : S :=
begin
--simp *, -- fails
simp * {contextual := tt},
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.default
import Mathlib.data.fintype.card
import Mathlib.PostPort

universes u_1 u_3 u_2

namespace Mathlib

/-!
# Homogeneous polynomials

A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`.

## Main definitions/lemmas

* `is_homogeneous φ n`: a predicate that asserts that `φ` is homogeneous of degree `n`.
* `homogeneous_component n`: the additive morphism that projects polynomials onto
  their summand that is homogeneous of degree `n`.
* `sum_homogeneous_component`: every polynomial is the sum of its homogeneous components

-/

namespace mv_polynomial

/-
TODO
* create definition for `∑ i in d.support, d i`
* define graded rings, and show that mv_polynomial is an example
-/

/-- A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`. -/
def is_homogeneous {σ : Type u_1} {R : Type u_3} [comm_semiring R] (φ : mv_polynomial σ R)
    (n : ℕ) :=
  ∀ {d : σ →₀ ℕ}, coeff d φ ≠ 0 → (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n

theorem is_homogeneous_monomial {σ : Type u_1} {R : Type u_3} [comm_semiring R] (d : σ →₀ ℕ) (r : R)
    (n : ℕ) (hn : (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n) :
    is_homogeneous (monomial d r) n :=
  sorry

theorem is_homogeneous_C (σ : Type u_1) {R : Type u_3} [comm_semiring R] (r : R) :
    is_homogeneous (coe_fn C r) 0 :=
  sorry

theorem is_homogeneous_zero (σ : Type u_1) (R : Type u_3) [comm_semiring R] (n : ℕ) :
    is_homogeneous 0 n :=
  fun (d : σ →₀ ℕ) (hd : coeff d 0 ≠ 0) => false.elim (hd (coeff_zero d))

theorem is_homogeneous_one (σ : Type u_1) (R : Type u_3) [comm_semiring R] : is_homogeneous 1 0 :=
  is_homogeneous_C σ 1

theorem is_homogeneous_X {σ : Type u_1} (R : Type u_3) [comm_semiring R] (i : σ) :
    is_homogeneous (X i) 1 :=
  sorry

namespace is_homogeneous

theorem coeff_eq_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R}
    {n : ℕ} (hφ : is_homogeneous φ n) (d : σ →₀ ℕ)
    (hd : (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) ≠ n) : coeff d φ = 0 :=
  eq.mp (Eq._oldrec (Eq.refl (¬coeff d φ ≠ 0)) (propext not_not)) (mt hφ hd)

theorem inj_right {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {m : ℕ}
    {n : ℕ} (hm : is_homogeneous φ m) (hn : is_homogeneous φ n) (hφ : φ ≠ 0) : m = n :=
  sorry

theorem add {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R}
    {ψ : mv_polynomial σ R} {n : ℕ} (hφ : is_homogeneous φ n) (hψ : is_homogeneous ψ n) :
    is_homogeneous (φ + ψ) n :=
  sorry

theorem sum {σ : Type u_1} {R : Type u_3} [comm_semiring R] {ι : Type u_2} (s : finset ι)
    (φ : ι → mv_polynomial σ R) (n : ℕ) (h : ∀ (i : ι), i ∈ s → is_homogeneous (φ i) n) :
    is_homogeneous (finset.sum s fun (i : ι) => φ i) n :=
  sorry

theorem mul {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R}
    {ψ : mv_polynomial σ R} {m : ℕ} {n : ℕ} (hφ : is_homogeneous φ m) (hψ : is_homogeneous ψ n) :
    is_homogeneous (φ * ψ) (m + n) :=
  sorry

theorem prod {σ : Type u_1} {R : Type u_3} [comm_semiring R] {ι : Type u_2} (s : finset ι)
    (φ : ι → mv_polynomial σ R) (n : ι → ℕ) (h : ∀ (i : ι), i ∈ s → is_homogeneous (φ i) (n i)) :
    is_homogeneous (finset.prod s fun (i : ι) => φ i) (finset.sum s fun (i : ι) => n i) :=
  sorry

theorem total_degree {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {n : ℕ}
    (hφ : is_homogeneous φ n) (h : φ ≠ 0) : total_degree φ = n :=
  sorry

end is_homogeneous

/-- `homogeneous_component n φ` is the part of `φ` that is homogeneous of degree `n`.
See `sum_homogeneous_component` for the statement that `φ` is equal to the sum
of all its homogeneous components. -/
def homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) :
    linear_map R (mv_polynomial σ R) (mv_polynomial σ R) :=
  linear_map.comp
    (submodule.subtype
      (finsupp.supported R R
        (set_of
          fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n)))
    (finsupp.restrict_dom R R
      (set_of fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n))

theorem coeff_homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ)
    (φ : mv_polynomial σ R) (d : σ →₀ ℕ) :
    coeff d (coe_fn (homogeneous_component n) φ) =
        ite ((finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n) (coeff d φ) 0 :=
  sorry

theorem homogeneous_component_apply {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ)
    (φ : mv_polynomial σ R) :
    coe_fn (homogeneous_component n) φ =
        finset.sum
          (finset.filter
            (fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n)
            (finsupp.support φ))
          fun (d : σ →₀ ℕ) => monomial d (coeff d φ) :=
  sorry

theorem homogeneous_component_is_homogeneous {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ)
    (φ : mv_polynomial σ R) : is_homogeneous (coe_fn (homogeneous_component n) φ) n :=
  sorry

theorem homogeneous_component_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R]
    (φ : mv_polynomial σ R) : coe_fn (homogeneous_component 0) φ = coe_fn C (coeff 0 φ) :=
  sorry

theorem homogeneous_component_eq_zero' {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ)
    (φ : mv_polynomial σ R)
    (h :
      ∀ (d : σ →₀ ℕ),
        d ∈ finsupp.support φ → (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) ≠ n) :
    coe_fn (homogeneous_component n) φ = 0 :=
  sorry

theorem homogeneous_component_eq_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ)
    (φ : mv_polynomial σ R) (h : total_degree φ < n) : coe_fn (homogeneous_component n) φ = 0 :=
  sorry

theorem sum_homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R]
    (φ : mv_polynomial σ R) :
    (finset.sum (finset.range (total_degree φ + 1))
          fun (i : ℕ) => coe_fn (homogeneous_component i) φ) =
        φ :=
  sorry

end Mathlib


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Bryan Gin-ge Chen
-/
import order.bounded_order
/-!
# (Generalized) Boolean algebras

A Boolean algebra is a bounded distributive lattice with a complement operator. Boolean algebras
generalize the (classical) logic of propositions and the lattice of subsets of a set.

Generalized Boolean algebras may be less familiar, but they are essentially Boolean algebras which
do not necessarily have a top element (`⊤`) (and hence not all elements may have complements). One
example in mathlib is `finset α`, the type of all finite subsets of an arbitrary
(not-necessarily-finite) type `α`.

`generalized_boolean_algebra α` is defined to be a distributive lattice with bottom (`⊥`) admitting
a *relative* complement operator, written using "set difference" notation as `x \ y` (`sdiff x y`).
For convenience, the `boolean_algebra` type class is defined to extend `generalized_boolean_algebra`
so that it is also bundled with a `\` operator.

(A terminological point: `x \ y` is the complement of `y` relative to the interval `[⊥, x]`. We do
not yet have relative complements for arbitrary intervals, as we do not even have lattice
intervals.)

## Main declarations

* `has_compl`: a type class for the complement operator
* `generalized_boolean_algebra`: a type class for generalized Boolean algebras
* `boolean_algebra.core`: a type class with the minimal assumptions for a Boolean algebras
* `boolean_algebra`: the main type class for Boolean algebras; it extends both
  `generalized_boolean_algebra` and `boolean_algebra.core`. An instance of `boolean_algebra` can be
  obtained from one of `boolean_algebra.core` using `boolean_algebra.of_core`.
* `Prop.boolean_algebra`: the Boolean algebra instance on `Prop`

## Implementation notes

The `sup_inf_sdiff` and `inf_inf_sdiff` axioms for the relative complement operator in
`generalized_boolean_algebra` are taken from
[Wikipedia](https://en.wikipedia.org/wiki/Boolean_algebra_(structure)#Generalizations).

[Stone's paper introducing generalized Boolean algebras][Stone1935] does not define a relative
complement operator `a \ b` for all `a`, `b`. Instead, the postulates there amount to an assumption
that for all `a, b : α` where `a ≤ b`, the equations `x ⊔ a = b` and `x ⊓ a = ⊥` have a solution
`x`. `disjoint.sdiff_unique` proves that this `x` is in fact `b \ a`.

## Notations

* `xᶜ` is notation for `compl x`
* `x \ y` is notation for `sdiff x y`.

## References

* <https://en.wikipedia.org/wiki/Boolean_algebra_(structure)#Generalizations>
* [*Postulates for Boolean Algebras and Generalized Boolean Algebras*, M.H. Stone][Stone1935]
* [*Lattice Theory: Foundation*, George Grätzer][Gratzer2011]

## Tags

generalized Boolean algebras, Boolean algebras, lattices, sdiff, compl
-/
set_option old_structure_cmd true

universes u v
variables {α : Type u} {w x y z : α}

/-!
### Generalized Boolean algebras

Some of the lemmas in this section are from:

* [*Lattice Theory: Foundation*, George Grätzer][Gratzer2011]
* <https://ncatlab.org/nlab/show/relative+complement>
* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

-/

export has_sdiff (sdiff)

/-- A generalized Boolean algebra is a distributive lattice with `⊥` and a relative complement
operation `\` (called `sdiff`, after "set difference") satisfying `(a ⊓ b) ⊔ (a \ b) = a` and
`(a ⊓ b) ⊓ (a \ b) = b`, i.e. `a \ b` is the complement of `b` in `a`.

This is a generalization of Boolean algebras which applies to `finset α` for arbitrary
(not-necessarily-`fintype`) `α`. -/
class generalized_boolean_algebra (α : Type u) extends distrib_lattice α, has_sdiff α, has_bot α :=
(sup_inf_sdiff : ∀a b:α, (a ⊓ b) ⊔ (a \ b) = a)
(inf_inf_sdiff : ∀a b:α, (a ⊓ b) ⊓ (a \ b) = ⊥)

-- We might want a `is_compl_of` predicate (for relative complements) generalizing `is_compl`,
-- however we'd need another type class for lattices with bot, and all the API for that.

section generalized_boolean_algebra
variables [generalized_boolean_algebra α]

@[simp] theorem sup_inf_sdiff (x y : α) : (x ⊓ y) ⊔ (x \ y) = x :=
generalized_boolean_algebra.sup_inf_sdiff _ _
@[simp] theorem inf_inf_sdiff (x y : α) : (x ⊓ y) ⊓ (x \ y) = ⊥ :=
generalized_boolean_algebra.inf_inf_sdiff _ _

@[simp] theorem sup_sdiff_inf (x y : α) : (x \ y) ⊔ (x ⊓ y) = x :=
by rw [sup_comm, sup_inf_sdiff]
@[simp] theorem inf_sdiff_inf (x y : α) : (x \ y) ⊓ (x ⊓ y) = ⊥ :=
by rw [inf_comm, inf_inf_sdiff]

@[priority 100]  -- see Note [lower instance priority]
instance generalized_boolean_algebra.to_order_bot : order_bot α :=
{ bot_le := λ a, by { rw [←inf_inf_sdiff a a, inf_assoc], exact inf_le_left },
  ..generalized_boolean_algebra.to_has_bot α }

theorem disjoint_inf_sdiff : disjoint (x ⊓ y) (x \ y) := (inf_inf_sdiff x y).le

-- TODO: in distributive lattices, relative complements are unique when they exist
theorem sdiff_unique (s : (x ⊓ y) ⊔ z = x) (i : (x ⊓ y) ⊓ z = ⊥) : x \ y = z :=
begin
  conv_rhs at s { rw [←sup_inf_sdiff x y, sup_comm] },
  rw sup_comm at s,
  conv_rhs at i { rw [←inf_inf_sdiff x y, inf_comm] },
  rw inf_comm at i,
  exact (eq_of_inf_eq_sup_eq i s).symm,
end

theorem sdiff_symm (hy : y ≤ x) (hz : z ≤ x) (H : x \ y = z) : x \ z = y :=
have hyi : x ⊓ y = y := inf_eq_right.2 hy,
have hzi : x ⊓ z = z := inf_eq_right.2 hz,
eq_of_inf_eq_sup_eq
  (begin
    have ixy := inf_inf_sdiff x y,
    rw [H, hyi] at ixy,
    have ixz := inf_inf_sdiff x z,
    rwa [hzi, inf_comm, ←ixy] at ixz,
  end)
  (begin
    have sxz := sup_inf_sdiff x z,
    rw [hzi, sup_comm] at sxz,
    rw sxz,
    symmetry,
    have sxy := sup_inf_sdiff x y,
    rwa [H, hyi] at sxy,
  end)

lemma sdiff_le : x \ y ≤ x :=
calc x \ y ≤ (x ⊓ y) ⊔ (x \ y) : le_sup_right
       ... = x                 : sup_inf_sdiff x y

@[simp] lemma bot_sdiff : ⊥ \ x = ⊥ := le_bot_iff.1 sdiff_le

lemma inf_sdiff_right : x ⊓ (x \ y) = x \ y := by rw [inf_of_le_right (@sdiff_le _ x y _)]
lemma inf_sdiff_left : (x \ y) ⊓ x = x \ y := by rw [inf_comm, inf_sdiff_right]

-- cf. `is_compl_top_bot`
@[simp] lemma sdiff_self : x \ x = ⊥ :=
by rw [←inf_inf_sdiff, inf_idem, inf_of_le_right (@sdiff_le _ x x _)]

@[simp] theorem sup_sdiff_self_right : x ⊔ (y \ x) = x ⊔ y :=
calc x ⊔ (y \ x) = (x ⊔ (x ⊓ y)) ⊔ (y \ x) : by rw sup_inf_self
             ... = x ⊔ ((y ⊓ x) ⊔ (y \ x)) : by ac_refl
             ... = x ⊔ y                   : by rw sup_inf_sdiff

@[simp] theorem sup_sdiff_self_left : (y \ x) ⊔ x = y ⊔ x :=
by rw [sup_comm, sup_sdiff_self_right, sup_comm]

lemma sup_sdiff_symm : x ⊔ (y \ x) = y ⊔ (x \ y) :=
by rw [sup_sdiff_self_right, sup_sdiff_self_right, sup_comm]

lemma sup_sdiff_cancel_right (h : x ≤ y) : x ⊔ (y \ x) = y :=
by conv_rhs { rw [←sup_inf_sdiff y x, inf_eq_right.2 h] }

lemma sdiff_sup_cancel (h : y ≤ x) : x \ y ⊔ y = x := by rw [sup_comm, sup_sdiff_cancel_right h]

lemma sup_le_of_le_sdiff_left (h : y ≤ z \ x) (hxz : x ≤ z) : x ⊔ y ≤ z :=
(sup_le_sup_left h x).trans (sup_sdiff_cancel_right hxz).le

lemma sup_le_of_le_sdiff_right (h : x ≤ z \ y) (hyz : y ≤ z) : x ⊔ y ≤ z :=
(sup_le_sup_right h y).trans (sdiff_sup_cancel hyz).le

@[simp] lemma sup_sdiff_left : x ⊔ (x \ y) = x := by { rw sup_eq_left, exact sdiff_le }
lemma sup_sdiff_right : (x \ y) ⊔ x = x := by rw [sup_comm, sup_sdiff_left]

@[simp] lemma sdiff_inf_sdiff : x \ y ⊓ (y \ x) = ⊥ :=
eq.symm $
  calc ⊥ = (x ⊓ y) ⊓ (x \ y)                           : by rw inf_inf_sdiff
     ... = (x ⊓ (y ⊓ x ⊔ y \ x)) ⊓ (x \ y)             : by rw sup_inf_sdiff
     ... = (x ⊓ (y ⊓ x) ⊔ x ⊓ (y \ x)) ⊓ (x \ y)       : by rw inf_sup_left
     ... = (y ⊓ (x ⊓ x) ⊔ x ⊓ (y \ x)) ⊓ (x \ y)       : by ac_refl
     ... = (y ⊓ x ⊔ x ⊓ (y \ x)) ⊓ (x \ y)             : by rw inf_idem
     ... = (x ⊓ y ⊓ (x \ y)) ⊔ (x ⊓ (y \ x) ⊓ (x \ y)) : by rw [inf_sup_right, @inf_comm _ _ x y]
     ... = x ⊓ (y \ x) ⊓ (x \ y)                       : by rw [inf_inf_sdiff, bot_sup_eq]
     ... = x ⊓ (x \ y) ⊓ (y \ x)                       : by ac_refl
     ... = (x \ y) ⊓ (y \ x)                           : by rw inf_sdiff_right

lemma disjoint_sdiff_sdiff : disjoint (x \ y) (y \ x) := sdiff_inf_sdiff.le

theorem le_sup_sdiff : y ≤ x ⊔ (y \ x) :=
by { rw [sup_sdiff_self_right], exact le_sup_right }

theorem le_sdiff_sup : y ≤ (y \ x) ⊔ x :=
by { rw [sup_comm], exact le_sup_sdiff }

@[simp] theorem inf_sdiff_self_right : x ⊓ (y \ x) = ⊥ :=
calc x ⊓ (y \ x) = ((x ⊓ y) ⊔ (x \ y)) ⊓ (y \ x)         : by rw sup_inf_sdiff
             ... = (x ⊓ y) ⊓ (y \ x) ⊔ (x \ y) ⊓ (y \ x) : by rw inf_sup_right
             ... = ⊥         : by rw [@inf_comm _ _ x y, inf_inf_sdiff, sdiff_inf_sdiff, bot_sup_eq]
@[simp] theorem inf_sdiff_self_left : (y \ x) ⊓ x = ⊥ := by rw [inf_comm, inf_sdiff_self_right]

theorem disjoint_sdiff_self_left : disjoint (y \ x) x := inf_sdiff_self_left.le
theorem disjoint_sdiff_self_right : disjoint x (y \ x) := inf_sdiff_self_right.le

lemma disjoint.disjoint_sdiff_left (h : disjoint x y) : disjoint (x \ z) y := h.mono_left sdiff_le
lemma disjoint.disjoint_sdiff_right (h : disjoint x y) : disjoint x (y \ z) := h.mono_right sdiff_le

/- TODO: we could make an alternative constructor for `generalized_boolean_algebra` using
`disjoint x (y \ x)` and `x ⊔ (y \ x) = y` as axioms. -/
theorem disjoint.sdiff_eq_of_sup_eq (hi : disjoint x z) (hs : x ⊔ z = y) : y \ x = z :=
have h : y ⊓ x = x := inf_eq_right.2 $ le_sup_left.trans hs.le,
sdiff_unique (by rw [h, hs]) (by rw [h, hi.eq_bot])

lemma disjoint.sup_sdiff_cancel_left (h : disjoint x y) : (x ⊔ y) \ x = y :=
h.sdiff_eq_of_sup_eq rfl
lemma disjoint.sup_sdiff_cancel_right (h : disjoint x y) : (x ⊔ y) \ y = x :=
h.symm.sdiff_eq_of_sup_eq sup_comm

protected theorem disjoint.sdiff_unique (hd : disjoint x z) (hz : z ≤ y) (hs : y ≤ x ⊔ z) :
  y \ x = z :=
sdiff_unique
  (begin
    rw ←inf_eq_right at hs,
    rwa [sup_inf_right, inf_sup_right, @sup_comm _ _ x, inf_sup_self, inf_comm, @sup_comm _ _ z,
      hs, sup_eq_left],
  end)
  (by rw [inf_assoc, hd.eq_bot, inf_bot_eq])

-- cf. `is_compl.disjoint_left_iff` and `is_compl.disjoint_right_iff`
lemma disjoint_sdiff_iff_le (hz : z ≤ y) (hx : x ≤ y) : disjoint z (y \ x) ↔ z ≤ x :=
⟨λ H, le_of_inf_le_sup_le
    (le_trans H bot_le)
    (begin
      rw sup_sdiff_cancel_right hx,
      refine le_trans (sup_le_sup_left sdiff_le z) _,
      rw sup_eq_right.2 hz,
    end),
 λ H, disjoint_sdiff_self_right.mono_left H⟩

-- cf. `is_compl.le_left_iff` and `is_compl.le_right_iff`
lemma le_iff_disjoint_sdiff (hz : z ≤ y) (hx : x ≤ y) : z ≤ x ↔ disjoint z (y \ x) :=
(disjoint_sdiff_iff_le hz hx).symm

-- cf. `is_compl.inf_left_eq_bot_iff` and `is_compl.inf_right_eq_bot_iff`
lemma inf_sdiff_eq_bot_iff (hz : z ≤ y) (hx : x ≤ y) : z ⊓ (y \ x) = ⊥ ↔ z ≤ x :=
by { rw ←disjoint_iff, exact disjoint_sdiff_iff_le hz hx }

-- cf. `is_compl.left_le_iff` and `is_compl.right_le_iff`
lemma le_iff_eq_sup_sdiff (hz : z ≤ y) (hx : x ≤ y) : x ≤ z ↔ y = z ⊔ (y \ x) :=
⟨λ H,
  begin
    apply le_antisymm,
    { conv_lhs { rw ←sup_inf_sdiff y x, },
      apply sup_le_sup_right,
      rwa inf_eq_right.2 hx, },
    { apply le_trans,
      { apply sup_le_sup_right hz, },
      { rw sup_sdiff_left, } }
  end,
 λ H,
  begin
    conv_lhs at H { rw ←sup_sdiff_cancel_right hx, },
    refine le_of_inf_le_sup_le _ H.le,
    rw inf_sdiff_self_right,
    exact bot_le,
  end⟩

-- cf. `set.union_diff_cancel'`
lemma sup_sdiff_cancel' (hx : x ≤ z) (hz : z ≤ y) : z ⊔ (y \ x) = y :=
((le_iff_eq_sup_sdiff hz (hx.trans hz)).1 hx).symm

-- cf. `is_compl.sup_inf`
lemma sdiff_sup : y \ (x ⊔ z) = (y \ x) ⊓ (y \ z) :=
sdiff_unique
  (calc y ⊓ (x ⊔ z) ⊔ y \ x ⊓ (y \ z) =
        (y ⊓ (x ⊔ z) ⊔ y \ x) ⊓ (y ⊓ (x ⊔ z) ⊔ (y \ z))         : by rw sup_inf_left
  ... = (y ⊓ x ⊔ y ⊓ z ⊔ y \ x) ⊓ (y ⊓ x ⊔ y ⊓ z ⊔ (y \ z))     : by rw @inf_sup_left _ _ y
  ... = (y ⊓ z ⊔ (y ⊓ x ⊔ y \ x)) ⊓ (y ⊓ x ⊔ (y ⊓ z ⊔ (y \ z))) : by ac_refl
  ... = (y ⊓ z ⊔ y) ⊓ (y ⊓ x ⊔ y)                             : by rw [sup_inf_sdiff, sup_inf_sdiff]
  ... = (y ⊔ y ⊓ z) ⊓ (y ⊔ y ⊓ x)                               : by ac_refl
  ... = y                                            : by rw [sup_inf_self, sup_inf_self, inf_idem])
  (calc y ⊓ (x ⊔ z) ⊓ ((y \ x) ⊓ (y \ z)) =
        (y ⊓ x ⊔ y ⊓ z) ⊓ ((y \ x) ⊓ (y \ z))                             : by rw inf_sup_left
  ... = ((y ⊓ x) ⊓ ((y \ x) ⊓ (y \ z))) ⊔ ((y ⊓ z) ⊓ ((y \ x) ⊓ (y \ z))) : by rw inf_sup_right
  ... = ((y ⊓ x) ⊓ (y \ x) ⊓ (y \ z)) ⊔ ((y \ x) ⊓ ((y \ z) ⊓ (y ⊓ z)))   : by ac_refl
  ... = ⊥ : by rw [inf_inf_sdiff, bot_inf_eq, bot_sup_eq, @inf_comm _ _ (y \ z), inf_inf_sdiff,
              inf_bot_eq])

-- cf. `is_compl.inf_sup`
lemma sdiff_inf : y \ (x ⊓ z) = y \ x ⊔ y \ z :=
sdiff_unique
  (calc y ⊓ (x ⊓ z) ⊔ (y \ x ⊔ y \ z) =
        (z ⊓ (y ⊓ x)) ⊔ (y \ x ⊔ y \ z)                     : by ac_refl
  ... = (z ⊔ (y \ x ⊔ y \ z)) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) : by rw sup_inf_right
  ... = (y \ x ⊔ (y \ z ⊔ z)) ⊓ (y ⊓ x ⊔ (y \ x ⊔ y \ z))   : by ac_refl
  ... = (y ⊔ z) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) :
                                            by rw [sup_sdiff_self_left, ←sup_assoc, sup_sdiff_right]
  ... = (y ⊔ z) ⊓ y                              : by rw [←sup_assoc, sup_inf_sdiff, sup_sdiff_left]
  ... = y                                                   : by rw [inf_comm, inf_sup_self])
  (calc y ⊓ (x ⊓ z) ⊓ ((y \ x) ⊔ (y \ z)) =
        (y ⊓ (x ⊓ z) ⊓ (y \ x)) ⊔ (y ⊓ (x ⊓ z) ⊓ (y \ z)) : by rw inf_sup_left
  ... = z ⊓ (y ⊓ x ⊓ (y \ x)) ⊔ z ⊓ (y ⊓ x) ⊓ (y \ z)     : by ac_refl
  ... = z ⊓ (y ⊓ x) ⊓ (y \ z)                        : by rw [inf_inf_sdiff, inf_bot_eq, bot_sup_eq]
  ... = x ⊓ ((y ⊓ z) ⊓ (y \ z))                           : by ac_refl
  ... = ⊥                                                 : by rw [inf_inf_sdiff, inf_bot_eq])

@[simp] lemma sdiff_inf_self_right : y \ (x ⊓ y) = y \ x :=
by rw [sdiff_inf, sdiff_self, sup_bot_eq]
@[simp] lemma sdiff_inf_self_left : y \ (y ⊓ x) = y \ x := by rw [inf_comm, sdiff_inf_self_right]

lemma sdiff_eq_sdiff_iff_inf_eq_inf : y \ x = y \ z ↔ y ⊓ x = y ⊓ z :=
⟨λ h, eq_of_inf_eq_sup_eq
  (by rw [inf_inf_sdiff, h, inf_inf_sdiff])
  (by rw [sup_inf_sdiff, h, sup_inf_sdiff]),
 λ h, by rw [←sdiff_inf_self_right, ←@sdiff_inf_self_right _ z y, inf_comm, h, inf_comm]⟩

theorem disjoint.sdiff_eq_left (h : disjoint x y) : x \ y = x :=
by conv_rhs { rw [←sup_inf_sdiff x y, h.eq_bot, bot_sup_eq] }
theorem disjoint.sdiff_eq_right (h : disjoint x y) : y \ x = y := h.symm.sdiff_eq_left

-- cf. `is_compl_bot_top`
@[simp] theorem sdiff_bot : x \ ⊥ = x := disjoint_bot_right.sdiff_eq_left

theorem sdiff_eq_self_iff_disjoint : x \ y = x ↔ disjoint y x :=
calc x \ y = x ↔ x \ y = x \ ⊥ : by rw sdiff_bot
           ... ↔ x ⊓ y = x ⊓ ⊥ : sdiff_eq_sdiff_iff_inf_eq_inf
           ... ↔ disjoint y x  : by rw [inf_bot_eq, inf_comm, disjoint_iff]

theorem sdiff_eq_self_iff_disjoint' : x \ y = x ↔ disjoint x y :=
by rw [sdiff_eq_self_iff_disjoint, disjoint.comm]

lemma sdiff_lt (hx : y ≤ x) (hy : y ≠ ⊥) :
  x \ y < x :=
begin
  refine sdiff_le.lt_of_ne (λ h, hy _),
  rw [sdiff_eq_self_iff_disjoint', disjoint_iff] at h,
  rw [←h, inf_eq_right.mpr hx],
end

-- cf. `is_compl.antitone`
lemma sdiff_le_sdiff_left (h : z ≤ x) : w \ x ≤ w \ z :=
le_of_inf_le_sup_le
  (calc (w \ x) ⊓ (w ⊓ z) ≤ (w \ x) ⊓ (w ⊓ x) : inf_le_inf le_rfl (inf_le_inf le_rfl h)
              ... = ⊥                         : by rw [inf_comm, inf_inf_sdiff]
              ... ≤ (w \ z) ⊓ (w ⊓ z)         : bot_le)
  (calc w \ x ⊔ (w ⊓ z) ≤ w \ x ⊔ (w ⊓ x)   : sup_le_sup le_rfl (inf_le_inf le_rfl h)
                    ... ≤ w                 : by rw [sup_comm, sup_inf_sdiff]
                    ... = (w \ z) ⊔ (w ⊓ z) : by rw [sup_comm, sup_inf_sdiff])

lemma sdiff_le_iff : y \ x ≤ z ↔ y ≤ x ⊔ z :=
⟨λ h, le_of_inf_le_sup_le
  (le_of_eq
    (calc y ⊓ (y \ x) = y \ x                         : inf_sdiff_right
                  ... = (x ⊓ (y \ x)) ⊔ (z ⊓ (y \ x)) :
                                          by rw [inf_eq_right.2 h, inf_sdiff_self_right, bot_sup_eq]
                  ... = (x ⊔ z) ⊓ (y \ x)             : inf_sup_right.symm))
  (calc y ⊔ y \ x = y                 : sup_sdiff_left
              ... ≤ y ⊔ (x ⊔ z)       : le_sup_left
              ... = ((y \ x) ⊔ x) ⊔ z : by rw [←sup_assoc, ←@sup_sdiff_self_left _ x y]
              ... = x ⊔ z ⊔ y \ x     : by ac_refl),
 λ h, le_of_inf_le_sup_le
  (calc y \ x ⊓ x = ⊥     : inf_sdiff_self_left
              ... ≤ z ⊓ x : bot_le)
  (calc y \ x ⊔ x = y ⊔ x       : sup_sdiff_self_left
              ... ≤ (x ⊔ z) ⊔ x : sup_le_sup_right h x
              ... ≤ z ⊔ x       : by rw [sup_assoc, sup_comm, sup_assoc, sup_idem])⟩

@[simp] lemma le_sdiff_iff : x ≤ y \ x ↔ x = ⊥ :=
⟨λ h, disjoint_self.1 (disjoint_sdiff_self_right.mono_right h), λ h, h.le.trans bot_le⟩

@[simp] lemma sdiff_eq_bot_iff : y \ x = ⊥ ↔ y ≤ x :=
by rw [←le_bot_iff, sdiff_le_iff, sup_bot_eq]

lemma sdiff_le_comm : x \ y ≤ z ↔ x \ z ≤ y :=
by rw [sdiff_le_iff, sup_comm, sdiff_le_iff]

lemma sdiff_le_sdiff_right (h : w ≤ y) : w \ x ≤ y \ x :=
le_of_inf_le_sup_le
  (calc (w \ x) ⊓ (w ⊓ x) = ⊥                 : by rw [inf_comm, inf_inf_sdiff]
                      ... ≤ (y \ x) ⊓ (w ⊓ x) : bot_le)
  (calc w \ x ⊔ (w ⊓ x) = w                       : by rw [sup_comm, sup_inf_sdiff]
                    ... ≤ (y ⊓ (y \ x)) ⊔ w       : le_sup_right
                    ... = (y ⊓ (y \ x)) ⊔ (y ⊓ w) : by rw inf_eq_right.2 h
                    ... = y ⊓ ((y \ x) ⊔ w)       : by rw inf_sup_left
                    ... = ((y \ x) ⊔ (y ⊓ x)) ⊓ ((y \ x) ⊔ w) :
                                                by rw [@sup_comm _ _ (y \ x) (y ⊓ x), sup_inf_sdiff]
                    ... = (y \ x) ⊔ ((y ⊓ x) ⊓ w) : by rw ←sup_inf_left
                    ... = (y \ x) ⊔ ((w ⊓ y) ⊓ x) : by ac_refl
                    ... = (y \ x) ⊔ (w ⊓ x)       : by rw inf_eq_left.2 h)

theorem sdiff_le_sdiff (h₁ : w ≤ y) (h₂ : z ≤ x) : w \ x ≤ y \ z :=
calc w \ x ≤ w \ z : sdiff_le_sdiff_left h₂
       ... ≤ y \ z : sdiff_le_sdiff_right h₁

lemma sdiff_lt_sdiff_right (h : x < y) (hz : z ≤ x) : x \ z < y \ z :=
(sdiff_le_sdiff_right h.le).lt_of_not_le $ λ h', h.not_le $
  le_sdiff_sup.trans $ sup_le_of_le_sdiff_right h' hz

lemma sup_inf_inf_sdiff : (x ⊓ y) ⊓ z ⊔ (y \ z) = (x ⊓ y) ⊔ (y \ z) :=
calc (x ⊓ y) ⊓ z ⊔ (y \ z) = x ⊓ (y ⊓ z) ⊔ (y \ z) : by rw inf_assoc
                       ... = (x ⊔ (y \ z)) ⊓ y     : by rw [sup_inf_right, sup_inf_sdiff]
                       ... = (x ⊓ y) ⊔ (y \ z)     : by rw [inf_sup_right, inf_sdiff_left]

@[simp] lemma inf_sdiff_sup_left : (x \ z) ⊓ (x ⊔ y) = x \ z :=
by rw [inf_sup_left, inf_sdiff_left, sup_inf_self]
@[simp] lemma inf_sdiff_sup_right : (x \ z) ⊓ (y ⊔ x) = x \ z :=
by rw [sup_comm, inf_sdiff_sup_left]

lemma sdiff_sdiff_right : x \ (y \ z) = (x \ y) ⊔ (x ⊓ y ⊓ z) :=
begin
  rw [sup_comm, inf_comm, ←inf_assoc, sup_inf_inf_sdiff],
  apply sdiff_unique,
  { calc x ⊓ (y \ z) ⊔ (z ⊓ x ⊔ x \ y) =
          (x ⊔ (z ⊓ x ⊔ x \ y)) ⊓ (y \ z ⊔ (z ⊓ x ⊔ x \ y)) : by rw sup_inf_right
    ... = (x ⊔ x ⊓ z ⊔ x \ y) ⊓ (y \ z ⊔ (x ⊓ z ⊔ x \ y))   : by ac_refl
    ... = x ⊓ (y \ z ⊔ x ⊓ z ⊔ x \ y)             : by rw [sup_inf_self, sup_sdiff_left, ←sup_assoc]
    ... = x ⊓ (y \ z ⊓ (z ⊔ y) ⊔ x ⊓ (z ⊔ y) ⊔ x \ y) :
                           by rw [sup_inf_left, sup_sdiff_self_left, inf_sup_right, @sup_comm _ _ y]
    ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ x ⊓ y) ⊔ x \ y) :
                                                by rw [inf_sdiff_sup_right, @inf_sup_left _ _ x z y]
    ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ (x ⊓ y ⊔ x \ y)))           : by ac_refl
    ... = x ⊓ (y \ z ⊔ (x ⊔ x ⊓ z))                   : by rw [sup_inf_sdiff, @sup_comm _ _ (x ⊓ z)]
    ... = x                                        : by rw [sup_inf_self, sup_comm, inf_sup_self] },
  { calc x ⊓ (y \ z) ⊓ (z ⊓ x ⊔ x \ y) =
          x ⊓ (y \ z) ⊓ (z ⊓ x) ⊔ x ⊓ (y \ z) ⊓ (x \ y) : by rw inf_sup_left
    ... = x ⊓ (y \ z ⊓ z ⊓ x) ⊔ x ⊓ (y \ z) ⊓ (x \ y)   : by ac_refl
    ... = x ⊓ (y \ z) ⊓ (x \ y) :    by rw [inf_sdiff_self_left, bot_inf_eq, inf_bot_eq, bot_sup_eq]
    ... = x ⊓ (y \ z ⊓ y) ⊓ (x \ y)                     : by conv_lhs { rw ←inf_sdiff_left }
    ... = x ⊓ (y \ z ⊓ (y ⊓ (x \ y)))                   : by ac_refl
    ... = ⊥                                 : by rw [inf_sdiff_self_right, inf_bot_eq, inf_bot_eq] }
end

lemma sdiff_sdiff_right' : x \ (y \ z) = (x \ y) ⊔ (x ⊓ z) :=
calc  x \ (y \ z) = (x \ y) ⊔ (x ⊓ y ⊓ z) : sdiff_sdiff_right
              ... = z ⊓ x ⊓ y ⊔ (x \ y)   : by ac_refl
              ... = (x \ y) ⊔ (x ⊓ z)     : by rw [sup_inf_inf_sdiff, sup_comm, inf_comm]

@[simp] lemma sdiff_sdiff_right_self : x \ (x \ y) = x ⊓ y :=
by rw [sdiff_sdiff_right, inf_idem, sdiff_self, bot_sup_eq]

lemma sdiff_sdiff_eq_self (h : y ≤ x) : x \ (x \ y) = y :=
by rw [sdiff_sdiff_right_self, inf_of_le_right h]

lemma sdiff_sdiff_left : (x \ y) \ z = x \ (y ⊔ z) :=
begin
  rw sdiff_sup,
  apply sdiff_unique,
  { rw [←inf_sup_left, sup_sdiff_self_right, inf_sdiff_sup_right] },
  { rw [inf_assoc, @inf_comm _ _ z, inf_assoc, inf_sdiff_self_left, inf_bot_eq, inf_bot_eq] }
end

lemma sdiff_sdiff_left' : (x \ y) \ z = (x \ y) ⊓ (x \ z) :=
by rw [sdiff_sdiff_left, sdiff_sup]

lemma sdiff_sdiff_comm : (x \ y) \ z = (x \ z) \ y :=
by rw [sdiff_sdiff_left, sup_comm, sdiff_sdiff_left]

@[simp] lemma sdiff_idem : x \ y \ y = x \ y := by rw [sdiff_sdiff_left, sup_idem]

@[simp] lemma sdiff_sdiff_self : x \ y \ x = ⊥ := by rw [sdiff_sdiff_comm, sdiff_self, bot_sdiff]

lemma sdiff_sdiff_sup_sdiff : z \ (x \ y ⊔ y \ x) = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x) :=
calc z \ (x \ y ⊔ y \ x) = (z \ x ⊔ z ⊓ x ⊓ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) :
                                             by rw [sdiff_sup, sdiff_sdiff_right, sdiff_sdiff_right]
... = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by rw [sup_inf_left, sup_comm, sup_inf_sdiff]
... = z ⊓ (z \ x ⊔ y) ⊓ (z ⊓ (z \ y ⊔ x)) :
                                          by rw [sup_inf_left, @sup_comm _ _ (z \ y), sup_inf_sdiff]
... = z ⊓ z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x)     : by ac_refl
... = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x)         : by rw inf_idem

lemma sdiff_sdiff_sup_sdiff' : z \ (x \ y ⊔ y \ x) = z ⊓ x ⊓ y ⊔ ((z \ x) ⊓ (z \ y)) :=
calc z \ (x \ y ⊔ y \ x) =
      z \ (x \ y) ⊓ (z \ (y \ x))               : sdiff_sup
... = (z \ x ⊔ z ⊓ x ⊓ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by rw [sdiff_sdiff_right, sdiff_sdiff_right]
... = (z \ x ⊔ z ⊓ y ⊓ x) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by ac_refl
... = (z \ x) ⊓ (z \ y) ⊔ z ⊓ y ⊓ x             : sup_inf_right.symm
... = z ⊓ x ⊓ y ⊔ ((z \ x) ⊓ (z \ y))           : by ac_refl

lemma sup_sdiff : (x ⊔ y) \ z = (x \ z) ⊔ (y \ z) :=
sdiff_unique
  (calc (x ⊔ y) ⊓ z ⊔ (x \ z ⊔ y \ z) =
        (x ⊓ z ⊔ y ⊓ z) ⊔ (x \ z ⊔ y \ z) : by rw inf_sup_right
  ... = x ⊓ z ⊔ x \ z ⊔ y \ z ⊔ y ⊓ z     : by ac_refl
  ... = x ⊔ (y ⊓ z ⊔ y \ z)               : by rw [sup_inf_sdiff, sup_assoc, @sup_comm _ _ (y \ z)]
  ... = x ⊔ y                             : by rw sup_inf_sdiff)
  (calc (x ⊔ y) ⊓ z ⊓ (x \ z ⊔ y \ z) =
        (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z ⊔ y \ z)                       : by rw inf_sup_right
  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
                                                           by rw [@inf_sup_left _ _ (x ⊓ z ⊔ y ⊓ z)]
  ... = (y ⊓ z ⊓ (x \ z)) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
                                                    by rw [inf_sup_right, inf_inf_sdiff, bot_sup_eq]
  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)  : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq, bot_sup_eq]
  ... = x ⊓ z ⊓ (y \ z)                           : by rw [inf_sup_right, inf_inf_sdiff, sup_bot_eq]
  ... = ⊥                                     : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq])

lemma sup_sdiff_right_self : (x ⊔ y) \ y = x \ y :=
by rw [sup_sdiff, sdiff_self, sup_bot_eq]

lemma sup_sdiff_left_self : (x ⊔ y) \ x = y \ x :=
by rw [sup_comm, sup_sdiff_right_self]

lemma inf_sdiff : (x ⊓ y) \ z = (x \ z) ⊓ (y \ z) :=
sdiff_unique
  (calc (x ⊓ y) ⊓ z ⊔ ((x \ z) ⊓ (y \ z)) =
        ((x ⊓ y) ⊓ z ⊔ (x \ z)) ⊓ ((x ⊓ y) ⊓ z ⊔ (y \ z)) : by rw [sup_inf_left]
  ... = (x ⊓ y ⊓ (z ⊔ x) ⊔ x \ z) ⊓ (x ⊓ y ⊓ z ⊔ y \ z) :
                     by rw [sup_inf_right, sup_sdiff_self_right, inf_sup_right, inf_sdiff_sup_right]
  ... = (y ⊓ (x ⊓ (x ⊔ z)) ⊔ x \ z) ⊓ (x ⊓ y ⊓ z ⊔ y \ z) : by ac_refl
  ... = ((y ⊓ x) ⊔ (x \ z)) ⊓ ((x ⊓ y) ⊔ (y \ z))         : by rw [inf_sup_self, sup_inf_inf_sdiff]
  ... = (x ⊓ y) ⊔ ((x \ z) ⊓ (y \ z))                     : by rw [@inf_comm _ _ y, sup_inf_left]
  ... = x ⊓ y                                        : sup_eq_left.2 (inf_le_inf sdiff_le sdiff_le))
  (calc (x ⊓ y) ⊓ z ⊓ ((x \ z) ⊓ (y \ z)) =
        x ⊓ y ⊓ (z ⊓ (x \ z)) ⊓ (y \ z) : by ac_refl
  ... = ⊥                               : by rw [inf_sdiff_self_right, inf_bot_eq, bot_inf_eq])

lemma inf_sdiff_assoc : (x ⊓ y) \ z = x ⊓ (y \ z) :=
sdiff_unique
  (calc x ⊓ y ⊓ z ⊔ x ⊓ (y \ z) = x ⊓ (y ⊓ z) ⊔ x ⊓ (y \ z) : by rw inf_assoc
                            ... = x ⊓ ((y ⊓ z) ⊔ y \ z)     : inf_sup_left.symm
                            ... = x ⊓ y                     : by rw sup_inf_sdiff)
  (calc x ⊓ y ⊓ z ⊓ (x ⊓ (y \ z)) = x ⊓ x ⊓ ((y ⊓ z) ⊓ (y \ z)) : by ac_refl
                              ... = ⊥                           : by rw [inf_inf_sdiff, inf_bot_eq])

lemma sup_eq_sdiff_sup_sdiff_sup_inf : x ⊔ y = (x \ y) ⊔ (y \ x) ⊔ (x ⊓ y) :=
eq.symm $
  calc (x \ y) ⊔ (y \ x) ⊔ (x ⊓ y) =
        ((x \ y) ⊔ (y \ x) ⊔ x) ⊓ ((x \ y) ⊔ (y \ x) ⊔ y)   : by rw sup_inf_left
  ... = ((x \ y) ⊔ x ⊔ (y \ x)) ⊓ ((x \ y) ⊔ ((y \ x) ⊔ y)) : by ac_refl
  ... = (x ⊔ (y \ x)) ⊓ ((x \ y) ⊔ y)                     : by rw [sup_sdiff_right, sup_sdiff_right]
  ... = x ⊔ y                          : by rw [sup_sdiff_self_right, sup_sdiff_self_left, inf_idem]

lemma sdiff_le_sdiff_of_sup_le_sup_left (h : z ⊔ x ≤ z ⊔ y) : x \ z ≤ y \ z :=
begin
  rw [←sup_sdiff_left_self, ←@sup_sdiff_left_self _ _ y],
  exact sdiff_le_sdiff_right h,
end

lemma sdiff_le_sdiff_of_sup_le_sup_right (h : x ⊔ z ≤ y ⊔ z) : x \ z ≤ y \ z :=
begin
  rw [←sup_sdiff_right_self, ←@sup_sdiff_right_self _ y],
  exact sdiff_le_sdiff_right h,
end

lemma sup_lt_of_lt_sdiff_left (h : y < z \ x) (hxz : x ≤ z) : x ⊔ y < z :=
begin
  rw ←sup_sdiff_cancel_right hxz,
  refine (sup_le_sup_left h.le _).lt_of_not_le (λ h', h.not_le _),
  rw ←sdiff_idem,
  exact (sdiff_le_sdiff_of_sup_le_sup_left h').trans sdiff_le,
end

lemma sup_lt_of_lt_sdiff_right (h : x < z \ y) (hyz : y ≤ z) : x ⊔ y < z :=
begin
  rw ←sdiff_sup_cancel hyz,
  refine (sup_le_sup_right h.le _).lt_of_not_le (λ h', h.not_le _),
  rw ←sdiff_idem,
  exact (sdiff_le_sdiff_of_sup_le_sup_right h').trans sdiff_le,
end

instance pi.generalized_boolean_algebra {α : Type u} {β : Type v} [generalized_boolean_algebra β] :
  generalized_boolean_algebra (α → β) :=
by pi_instance

end generalized_boolean_algebra

/-!
### Boolean algebras
-/

/-- Set / lattice complement -/
@[notation_class] class has_compl (α : Type*) := (compl : α → α)

export has_compl (compl)

postfix `ᶜ`:(max+1) := compl

/-- This class contains the core axioms of a Boolean algebra. The `boolean_algebra` class extends
both this class and `generalized_boolean_algebra`, see Note [forgetful inheritance].

Since `bounded_order`, `order_bot`, and `order_top` are mixins that require `has_le`
to be present at define-time, the `extends` mechanism does not work with them.
Instead, we extend using the underlying `has_bot` and `has_top` data typeclasses, and replicate the
order axioms of those classes here. A "forgetful" instance back to `bounded_order` is provided.
-/
class boolean_algebra.core (α : Type u) extends distrib_lattice α, has_compl α,
  has_top α, has_bot α :=
(inf_compl_le_bot : ∀x:α, x ⊓ xᶜ ≤ ⊥)
(top_le_sup_compl : ∀x:α, ⊤ ≤ x ⊔ xᶜ)
(le_top : ∀ a : α, a ≤ ⊤)
(bot_le : ∀ a : α, ⊥ ≤ a)

@[priority 100]  -- see Note [lower instance priority]
instance boolean_algebra.core.to_bounded_order [h : boolean_algebra.core α] : bounded_order α :=
{ ..h }

section boolean_algebra_core
variables [boolean_algebra.core α]

@[simp] theorem inf_compl_eq_bot : x ⊓ xᶜ = ⊥ :=
bot_unique $ boolean_algebra.core.inf_compl_le_bot x

@[simp] theorem compl_inf_eq_bot : xᶜ ⊓ x = ⊥ :=
eq.trans inf_comm inf_compl_eq_bot

@[simp] theorem sup_compl_eq_top : x ⊔ xᶜ = ⊤ :=
top_unique $ boolean_algebra.core.top_le_sup_compl x

@[simp] theorem compl_sup_eq_top : xᶜ ⊔ x = ⊤ :=
eq.trans sup_comm sup_compl_eq_top

theorem is_compl_compl : is_compl x xᶜ :=
is_compl.of_eq inf_compl_eq_bot sup_compl_eq_top

theorem is_compl.eq_compl (h : is_compl x y) : x = yᶜ :=
h.left_unique is_compl_compl.symm

theorem is_compl.compl_eq (h : is_compl x y) : xᶜ = y :=
(h.right_unique is_compl_compl).symm

theorem eq_compl_iff_is_compl : x = yᶜ ↔ is_compl x y :=
⟨λ h, by { rw h, exact is_compl_compl.symm }, is_compl.eq_compl⟩

theorem compl_eq_iff_is_compl : xᶜ = y ↔ is_compl x y :=
⟨λ h, by { rw ←h, exact is_compl_compl }, is_compl.compl_eq⟩

theorem disjoint_compl_right : disjoint x xᶜ := is_compl_compl.disjoint
theorem disjoint_compl_left : disjoint xᶜ x := disjoint_compl_right.symm

theorem compl_unique (i : x ⊓ y = ⊥) (s : x ⊔ y = ⊤) : xᶜ = y :=
(is_compl.of_eq i s).compl_eq

@[simp] theorem compl_top : ⊤ᶜ = (⊥:α) :=
is_compl_top_bot.compl_eq

@[simp] theorem compl_bot : ⊥ᶜ = (⊤:α) :=
is_compl_bot_top.compl_eq

@[simp] theorem compl_compl (x : α) : xᶜᶜ = x :=
is_compl_compl.symm.compl_eq

@[simp] theorem compl_involutive : function.involutive (compl : α → α) := compl_compl

theorem compl_bijective : function.bijective (compl : α → α) :=
compl_involutive.bijective

theorem compl_surjective : function.surjective (compl : α → α) :=
compl_involutive.surjective

theorem compl_injective : function.injective (compl : α → α) :=
compl_involutive.injective

@[simp] theorem compl_inj_iff : xᶜ = yᶜ ↔ x = y :=
compl_injective.eq_iff

theorem is_compl.compl_eq_iff (h : is_compl x y) : zᶜ = y ↔ z = x :=
h.compl_eq ▸ compl_inj_iff

@[simp] theorem compl_eq_top : xᶜ = ⊤ ↔ x = ⊥ :=
is_compl_bot_top.compl_eq_iff

@[simp] theorem compl_eq_bot : xᶜ = ⊥ ↔ x = ⊤ :=
is_compl_top_bot.compl_eq_iff

@[simp] theorem compl_inf : (x ⊓ y)ᶜ = xᶜ ⊔ yᶜ :=
(is_compl_compl.inf_sup is_compl_compl).compl_eq

@[simp] theorem compl_sup : (x ⊔ y)ᶜ = xᶜ ⊓ yᶜ :=
(is_compl_compl.sup_inf is_compl_compl).compl_eq

theorem compl_le_compl (h : y ≤ x) : xᶜ ≤ yᶜ :=
is_compl_compl.antitone is_compl_compl h

@[simp] theorem compl_le_compl_iff_le : yᶜ ≤ xᶜ ↔ x ≤ y :=
⟨assume h, by have h := compl_le_compl h; simp at h; assumption,
  compl_le_compl⟩

theorem le_compl_of_le_compl (h : y ≤ xᶜ) : x ≤ yᶜ :=
by simpa only [compl_compl] using compl_le_compl h

theorem compl_le_of_compl_le (h : yᶜ ≤ x) : xᶜ ≤ y :=
by simpa only [compl_compl] using compl_le_compl h

theorem le_compl_iff_le_compl : y ≤ xᶜ ↔ x ≤ yᶜ :=
⟨le_compl_of_le_compl, le_compl_of_le_compl⟩

theorem compl_le_iff_compl_le : xᶜ ≤ y ↔ yᶜ ≤ x :=
⟨compl_le_of_compl_le, compl_le_of_compl_le⟩

namespace boolean_algebra

@[priority 100]
instance : is_complemented α := ⟨λ x, ⟨xᶜ, is_compl_compl⟩⟩

end boolean_algebra

end boolean_algebra_core

/-- A Boolean algebra is a bounded distributive lattice with
a complement operator `ᶜ` such that `x ⊓ xᶜ = ⊥` and `x ⊔ xᶜ = ⊤`.
For convenience, it must also provide a set difference operation `\`
satisfying `x \ y = x ⊓ yᶜ`.

This is a generalization of (classical) logic of propositions, or
the powerset lattice. -/
-- Lean complains about metavariables in the type if the universe is not specified
class boolean_algebra (α : Type u) extends generalized_boolean_algebra α, boolean_algebra.core α :=
(sdiff_eq : ∀x y:α, x \ y = x ⊓ yᶜ)
-- TODO: is there a way to automatically fill in the proofs of sup_inf_sdiff and inf_inf_sdiff given
-- everything in `boolean_algebra.core` and `sdiff_eq`? The following doesn't work:
-- (sup_inf_sdiff := λ a b, by rw [sdiff_eq, ←inf_sup_left, sup_compl_eq_top, inf_top_eq])

section of_core

/-- Create a `has_sdiff` instance from a `boolean_algebra.core` instance, defining `x \ y` to
be `x ⊓ yᶜ`.

For some types, it may be more convenient to create the `boolean_algebra` instance by hand in order
to have a simpler `sdiff` operation.

See note [reducible non-instances]. -/
@[reducible]
def boolean_algebra.core.sdiff [boolean_algebra.core α] : has_sdiff α := ⟨λ x y, x ⊓ yᶜ⟩

local attribute [instance] boolean_algebra.core.sdiff

lemma boolean_algebra.core.sdiff_eq [boolean_algebra.core α] (a b : α) :
  a \ b = a ⊓ bᶜ := rfl

/-- Create a `boolean_algebra` instance from a `boolean_algebra.core` instance, defining `x \ y` to
be `x ⊓ yᶜ`.

For some types, it may be more convenient to create the `boolean_algebra` instance by hand in order
to have a simpler `sdiff` operation. -/
def boolean_algebra.of_core (B : boolean_algebra.core α) :
  boolean_algebra α :=
{ sdiff := λ x y, x ⊓ yᶜ,
  sdiff_eq := λ _ _, rfl,
  sup_inf_sdiff := λ a b, by rw [←inf_sup_left, sup_compl_eq_top, inf_top_eq],
  inf_inf_sdiff := λ a b, by { rw [inf_left_right_swap, boolean_algebra.core.sdiff_eq,
    @inf_assoc _ _ _ _ b, compl_inf_eq_bot, inf_bot_eq, bot_inf_eq], congr },
  ..B }

end of_core

section boolean_algebra
variables [boolean_algebra α]

theorem sdiff_eq : x \ y = x ⊓ yᶜ := boolean_algebra.sdiff_eq x y

theorem sdiff_compl : x \ yᶜ = x ⊓ y := by rw [sdiff_eq, compl_compl]

theorem top_sdiff : ⊤ \ x = xᶜ := by rw [sdiff_eq, top_inf_eq]
@[simp] theorem sdiff_top : x \ ⊤ = ⊥ := by rw [sdiff_eq, compl_top, inf_bot_eq]

@[simp] lemma sup_inf_inf_compl : (x ⊓ y) ⊔ (x ⊓ yᶜ) = x :=
by rw [← sdiff_eq, sup_inf_sdiff _ _]

end boolean_algebra

instance Prop.boolean_algebra : boolean_algebra Prop :=
boolean_algebra.of_core
{ compl := not,
  inf_compl_le_bot := λ p ⟨Hp, Hpc⟩, Hpc Hp,
  top_le_sup_compl := λ p H, classical.em p,
  .. Prop.distrib_lattice,
  .. Prop.bounded_order }

instance pi.has_sdiff {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] :
  has_sdiff (Π i, α i) :=
⟨λ x y i, x i \ y i⟩

lemma pi.sdiff_def {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) :
  (x \ y) = λ i, x i \ y i := rfl

@[simp]
lemma pi.sdiff_apply {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) (i : ι) :
  (x \ y) i = x i \ y i := rfl

instance pi.has_compl {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] :
  has_compl (Π i, α i) :=
⟨λ x i, (x i)ᶜ⟩

lemma pi.compl_def {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) :
  xᶜ = λ i, (x i)ᶜ := rfl

@[simp]
lemma pi.compl_apply {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) (i : ι)  :
  xᶜ i = (x i)ᶜ := rfl

instance pi.boolean_algebra {ι : Type u} {α : ι → Type v} [∀ i, boolean_algebra (α i)] :
  boolean_algebra (Π i, α i) :=
{ sdiff_eq := λ x y, funext $ λ i, sdiff_eq,
  sup_inf_sdiff := λ x y, funext $ λ i, sup_inf_sdiff (x i) (y i),
  inf_inf_sdiff := λ x y, funext $ λ i, inf_inf_sdiff (x i) (y i),
  inf_compl_le_bot := λ _ _, boolean_algebra.inf_compl_le_bot _,
  top_le_sup_compl := λ _ _, boolean_algebra.top_le_sup_compl _,
  .. pi.has_sdiff,
  .. pi.has_compl,
  .. pi.bounded_order,
  .. pi.distrib_lattice }


import day_3.groups

/-!

## Subgroups

We define the structure `subgroup G`, whose terms are subgroups of `G`.
A subgroup of `G` is implemented as a subset of `G` closed under
`1`, `*` and `⁻¹`.

-/

namespace mbl

/-- A subgroup of a group G is a subset containing 1
and closed under multiplication and inverse. -/
structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

/-

At this point, here's what we have.

A term `H` of type `subgroup G`, written `H : subgroup G`, is a
*quadruple*. To give a term `H : subgroup G` is to give the following four things:
1) `H.carrier` (a subset of `G`),
2) `H.one_mem'` (a proof that `1 ∈ H.carrier`),
3) `H.mul_mem'` (a proof that `H` is closed under multiplication)
4) `H.inv_mem'` (a proof that `H` is closed under inverses).

Note in particular that Lean, being super-pedantic, *distinguishes* between
the subgroup `H` and the subset `H.carrier`. One is a subgroup, one is
a subset. When we get going we will start by setting up some infrastructure
so that this difference will be hard to notice.

Note also that if `x` is in the subgroup `H` of `H` then the _type_ of `x` is still `G`,
and `x ∈ carrier` is a Proposition. Note also that `x : carrier` doesn't
make sense (`carrier` is a term, not a type, rather counterintuitively).

-/

namespace subgroup
open mbl.group

variables {G : Type} [group G] (H J K : subgroup G)

/-
We don't want to write `H.carrier` to refer to the underlying set
everywhere, because we want to be able to identify the subgroup `H` with
its underlying subset `H.carrier`. Note that these things are not _equal_,
firstly because `H` contains the proof that `H.carrier` is a subgroup, and
secondly because these terms have different types! `H` has type `subgroup G`
and `H.carrier` has type `set G`. Let's start by sorting this out.
-/

-- If `x : G` and `H : subgroup G` then let's define the notation
-- `x ∈ H` to mean `x ∈ H.carrier`
instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

-- Let's also define a "coercion", a.k.a. an "invisible map"
-- from subgroups of `G` to subsets of `G`, sending `H` to `H.carrier`.
-- The map is not completely invisible -- it's a little ↑. So
-- if you see `↑H` in the future, it means the subset `H.carrier` by definition.
instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

/-- `g` is in the underlying subset of `H` iff `g ∈ H`. -/
@[simp] lemma mem_carrier {g : G} : g ∈ H.carrier ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

/-- `g` is in `H` considered as a subset of `G`, iff `g` is in `H` considered
as subgroup of `G`. -/
@[simp] lemma mem_coe {g : G} : g ∈ (↑H : set G) ↔ g ∈ H :=
begin
  -- true by definition
  refl
end

-- Now let's define theorems without the `'`s in, which use this
-- more natural notation

/-- A subgroup contains the group's 1. -/
theorem one_mem : (1 : G) ∈ H :=
begin
  sorry,
end

/-- A subgroup is closed under multiplication. -/
theorem mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H :=
begin
  sorry,
end

/-- A subgroup is closed under inverse -/
theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H :=
begin
  sorry,
end

/-

So here are the three theorems which you need to remember about subgroups.
Say `H : subgroup G`. Then:

`H.one_mem : (1 : G) ∈ H`
`H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H`
`H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H`

These now look like the way a mathematician would write things.

Now let's start to prove basic theorems about subgroups (or, as a the computer
scientists would say, make a basic _interface_ or _API_ for subgroups),
using this sensible notation.

Here's an example; let's prove `x ∈ H ↔ x⁻¹ ∈ H`. Let's put the more
complicated expression on the left hand side of the `↔` though, because then
we can make it a `simp` lemma.
-/

-- Remember that `xena.group.inv_inv x` is the statement that `x⁻¹⁻¹ = x`

@[simp] theorem inv_mem_iff {x : G} : x⁻¹ ∈ H ↔ x ∈ H :=
begin
  sorry,
end

-- We could prove a bunch more theorems here. Let's just do one more.
-- Let's show that if x and xy are in H then so is y.

theorem mem_of_mem_mul_mem {x y : G} (hx : x ∈ H) (hxy : x * y ∈ H) : y ∈ H :=
begin
  sorry,
end

end subgroup
end mbl


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.mean_inequalities

/-!
# `L^p` distance on finite products of metric spaces
Given finitely many metric spaces, one can put the max distance on their product, but there is also
a whole family of natural distances, indexed by a real parameter `p ∈ [1, ∞)`, that also induce
the product topology. We define them in this file. The distance on `Π i, α i` is given by
$$
d(x, y) = \left(\sum d(x_i, y_i)^p\right)^{1/p}.
$$

We give instances of this construction for emetric spaces, metric spaces, normed groups and normed
spaces.

To avoid conflicting instances, all these are defined on a copy of the original Pi type, named
`pi_Lp p hp α`, where `hp : 1 ≤ p`. This assumption is included in the definition of the type
to make sure that it is always available to typeclass inference to construct the instances.

We ensure that the topology and uniform structure on `pi_Lp p hp α` are (defeq to) the product
topology and product uniformity, to be able to use freely continuity statements for the coordinate
functions, for instance.

## Implementation notes

We only deal with the `L^p` distance on a product of finitely many metric spaces, which may be
distinct. A closely related construction is the `L^p` norm on the space of
functions from a measure space to a normed space, where the norm is
$$
\left(\int ∥f (x)∥^p dμ\right)^{1/p}.
$$
However, the topology induced by this construction is not the product topology, this only
defines a seminorm (as almost everywhere zero functions have zero `L^p` norm), and some functions
have infinite `L^p` norm. All these subtleties are not present in the case of finitely many
metric spaces (which corresponds to the basis which is a finite space with the counting measure),
hence it is worth devoting a file to this specific case which is particularly well behaved.
The general case is not yet formalized in mathlib.

To prove that the topology (and the uniform structure) on a finite product with the `L^p` distance
are the same as those coming from the `L^∞` distance, we could argue that the `L^p` and `L^∞` norms
are equivalent on `ℝ^n` for abstract (norm equivalence) reasons. Instead, we give a more explicit
(easy) proof which provides a comparison between these two norms with explicit constants.

We also set up the theory for `pseudo_emetric_space` and `pseudo_metric_space`.
-/

open real set filter
open_locale big_operators uniformity topological_space nnreal ennreal

noncomputable theory

variables {ι : Type*}

/-- A copy of a Pi type, on which we will put the `L^p` distance. Since the Pi type itself is
already endowed with the `L^∞` distance, we need the type synonym to avoid confusing typeclass
resolution. Also, we let it depend on `p`, to get a whole family of type on which we can put
different distances, and we provide the assumption `hp` in the definition, to make it available
to typeclass resolution when it looks for a distance on `pi_Lp p hp α`. -/
@[nolint unused_arguments]
def pi_Lp {ι : Type*} (p : ℝ) (hp : 1 ≤ p) (α : ι → Type*) : Type* := Π (i : ι), α i

instance {ι : Type*} (p : ℝ) (hp : 1 ≤ p) (α : ι → Type*) [∀ i, inhabited (α i)] :
  inhabited (pi_Lp p hp α) :=
⟨λ i, default (α i)⟩

namespace pi_Lp

variables (p : ℝ) (hp : 1 ≤ p) (α : ι → Type*) (β : ι → Type*)

/-- Canonical bijection between `pi_Lp p hp α` and the original Pi type. We introduce it to be able
to compare the `L^p` and `L^∞` distances through it. -/
protected def equiv : pi_Lp p hp α ≃ Π (i : ι), α i :=
equiv.refl _

section
/-!
### The uniformity on finite `L^p` products is the product uniformity

In this section, we put the `L^p` edistance on `pi_Lp p hp α`, and we check that the uniformity
coming from this edistance coincides with the product uniformity, by showing that the canonical
map to the Pi type (with the `L^∞` distance) is a uniform embedding, as it is both Lipschitz and
antiLipschitz.

We only register this emetric space structure as a temporary instance, as the true instance (to be
registered later) will have as uniformity exactly the product uniformity, instead of the one coming
from the edistance (which is equal to it, but not defeq). See Note [forgetful inheritance]
explaining why having definitionally the right uniformity is often important.
-/

variables [∀ i, emetric_space (α i)] [∀ i, pseudo_emetric_space (β i)] [fintype ι]

/-- Endowing the space `pi_Lp p hp β` with the `L^p` pseudoedistance. This definition is not
satisfactory, as it does not register the fact that the topology and the uniform structure coincide
with the product one. Therefore, we do not register it as an instance. Using this as a temporary
pseudoemetric space instance, we will show that the uniform structure is equal (but not defeq) to
the product one, and then register an instance in which we replace the uniform structure by the
product one using this pseudoemetric space and `pseudo_emetric_space.replace_uniformity`. -/
def pseudo_emetric_aux : pseudo_emetric_space (pi_Lp p hp β) :=
have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
{ edist          := λ f g, (∑ (i : ι), (edist (f i) (g i)) ^ p) ^ (1/p),
  edist_self     := λ f, by simp [edist, ennreal.zero_rpow_of_pos pos,
                                  ennreal.zero_rpow_of_pos (inv_pos.2 pos)],
  edist_comm     := λ f g, by simp [edist, edist_comm],
  edist_triangle := λ f g h, calc
    (∑ (i : ι), edist (f i) (h i) ^ p) ^ (1 / p) ≤
    (∑ (i : ι), (edist (f i) (g i) + edist (g i) (h i)) ^ p) ^ (1 / p) :
    begin
      apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ le_of_lt pos),
      refine finset.sum_le_sum (λ i hi, _),
      exact ennreal.rpow_le_rpow (edist_triangle _ _ _) (le_trans zero_le_one hp)
    end
    ... ≤
    (∑ (i : ι), edist (f i) (g i) ^ p) ^ (1 / p) + (∑ (i : ι), edist (g i) (h i) ^ p) ^ (1 / p) :
      ennreal.Lp_add_le _ _ _ hp }

/-- Endowing the space `pi_Lp p hp α` with the `L^p` edistance. This definition is not satisfactory,
as it does not register the fact that the topology and the uniform structure coincide with the
product one. Therefore, we do not register it as an instance. Using this as a temporary emetric
space instance, we will show that the uniform structure is equal (but not defeq) to the product one,
and then register an instance in which we replace the uniform structure by the product one using
this emetric space and `emetric_space.replace_uniformity`. -/
def emetric_aux : emetric_space (pi_Lp p hp α) :=
{ eq_of_edist_eq_zero := λ f g hfg,
  begin
    have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
    letI h := pseudo_emetric_aux p hp α,
    have h : edist f g = (∑ (i : ι), (edist (f i) (g i)) ^ p) ^ (1/p) := rfl,
    simp [h, ennreal.rpow_eq_zero_iff, pos, asymm pos, finset.sum_eq_zero_iff_of_nonneg] at hfg,
    exact funext hfg
  end,
  ..pseudo_emetric_aux p hp α }

local attribute [instance] pi_Lp.emetric_aux pi_Lp.pseudo_emetric_aux

lemma lipschitz_with_equiv : lipschitz_with 1 (pi_Lp.equiv p hp β) :=
begin
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  have cancel : p * (1/p) = 1 := mul_div_cancel' 1 (ne_of_gt pos),
  assume x y,
  simp only [edist, forall_prop_of_true, one_mul, finset.mem_univ, finset.sup_le_iff,
             ennreal.coe_one],
  assume i,
  calc
  edist (x i) (y i) = (edist (x i) (y i) ^ p) ^ (1/p) :
    by simp [← ennreal.rpow_mul, cancel, -one_div]
  ... ≤ (∑ (i : ι), edist (x i) (y i) ^ p) ^ (1 / p) :
  begin
    apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ le_of_lt pos),
    exact finset.single_le_sum (λ i hi, (bot_le : (0 : ℝ≥0∞) ≤ _)) (finset.mem_univ i)
  end
end

lemma antilipschitz_with_equiv :
  antilipschitz_with ((fintype.card ι : ℝ≥0) ^ (1/p)) (pi_Lp.equiv p hp β) :=
begin
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  have nonneg : 0 ≤ 1 / p := one_div_nonneg.2 (le_of_lt pos),
  have cancel : p * (1/p) = 1 := mul_div_cancel' 1 (ne_of_gt pos),
  assume x y,
  simp [edist, -one_div],
  calc (∑ (i : ι), edist (x i) (y i) ^ p) ^ (1 / p) ≤
  (∑ (i : ι), edist (pi_Lp.equiv p hp β x) (pi_Lp.equiv p hp β y) ^ p) ^ (1 / p) :
  begin
    apply ennreal.rpow_le_rpow _ nonneg,
    apply finset.sum_le_sum (λ i hi, _),
    apply ennreal.rpow_le_rpow _ (le_of_lt pos),
    exact finset.le_sup (finset.mem_univ i)
  end
  ... = (((fintype.card ι : ℝ≥0)) ^ (1/p) : ℝ≥0) *
    edist (pi_Lp.equiv p hp β x) (pi_Lp.equiv p hp β y) :
  begin
    simp only [nsmul_eq_mul, finset.card_univ, ennreal.rpow_one, finset.sum_const,
      ennreal.mul_rpow_of_nonneg _ _ nonneg, ←ennreal.rpow_mul, cancel],
    have : (fintype.card ι : ℝ≥0∞) = (fintype.card ι : ℝ≥0) :=
      (ennreal.coe_nat (fintype.card ι)).symm,
    rw [this, ennreal.coe_rpow_of_nonneg _ nonneg]
  end
end

lemma aux_uniformity_eq :
  𝓤 (pi_Lp p hp β) = @uniformity _ (Pi.uniform_space _) :=
begin
  have A : uniform_inducing (pi_Lp.equiv p hp β) :=
    (antilipschitz_with_equiv p hp β).uniform_inducing
    (lipschitz_with_equiv p hp β).uniform_continuous,
  have : (λ (x : pi_Lp p hp β × pi_Lp p hp β),
    ((pi_Lp.equiv p hp β) x.fst, (pi_Lp.equiv p hp β) x.snd)) = id,
    by ext i; refl,
  rw [← A.comap_uniformity, this, comap_id]
end

end

/-! ### Instances on finite `L^p` products -/

instance uniform_space [∀ i, uniform_space (β i)] : uniform_space (pi_Lp p hp β) :=
Pi.uniform_space _

variable [fintype ι]

/-- pseudoemetric space instance on the product of finitely many pseudoemetric spaces, using the
`L^p` pseudoedistance, and having as uniformity the product uniformity. -/
instance [∀ i, pseudo_emetric_space (β i)] : pseudo_emetric_space (pi_Lp p hp β) :=
(pseudo_emetric_aux p hp β).replace_uniformity (aux_uniformity_eq p hp β).symm

/-- emetric space instance on the product of finitely many emetric spaces, using the `L^p`
edistance, and having as uniformity the product uniformity. -/
instance [∀ i, emetric_space (α i)] : emetric_space (pi_Lp p hp α) :=
(emetric_aux p hp α).replace_uniformity (aux_uniformity_eq p hp α).symm

protected lemma edist {p : ℝ} {hp : 1 ≤ p} {β : ι → Type*}
  [∀ i, pseudo_emetric_space (β i)] (x y : pi_Lp p hp β) :
  edist x y = (∑ (i : ι), (edist (x i) (y i)) ^ p) ^ (1/p) := rfl

/-- pseudometric space instance on the product of finitely many psuedometric spaces, using the
`L^p` distance, and having as uniformity the product uniformity. -/
instance [∀ i, pseudo_metric_space (β i)] : pseudo_metric_space (pi_Lp p hp β) :=
begin
  /- we construct the instance from the pseudo emetric space instance to avoid checking again that
  the uniformity is the same as the product uniformity, but we register nevertheless a nice formula
  for the distance -/
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  refine pseudo_emetric_space.to_pseudo_metric_space_of_dist
    (λf g, (∑ (i : ι), (dist (f i) (g i)) ^ p) ^ (1/p)) (λ f g, _) (λ f g, _),
  { simp [pi_Lp.edist, ennreal.rpow_eq_top_iff, asymm pos, pos,
          ennreal.sum_eq_top_iff, edist_ne_top] },
  { have A : ∀ (i : ι), i ∈ (finset.univ : finset ι) → edist (f i) (g i) ^ p < ⊤ :=
      λ i hi, by simp [lt_top_iff_ne_top, edist_ne_top, le_of_lt pos],
    simp [dist, -one_div, pi_Lp.edist, ← ennreal.to_real_rpow,
          ennreal.to_real_sum A, dist_edist] }
end

/-- metric space instance on the product of finitely many metric spaces, using the `L^p` distance,
and having as uniformity the product uniformity. -/
instance [∀ i, metric_space (α i)] : metric_space (pi_Lp p hp α) :=
begin
  /- we construct the instance from the emetric space instance to avoid checking again that the
  uniformity is the same as the product uniformity, but we register nevertheless a nice formula
  for the distance -/
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  refine emetric_space.to_metric_space_of_dist
    (λf g, (∑ (i : ι), (dist (f i) (g i)) ^ p) ^ (1/p)) (λ f g, _) (λ f g, _),
  { simp [pi_Lp.edist, ennreal.rpow_eq_top_iff, asymm pos, pos,
          ennreal.sum_eq_top_iff, edist_ne_top] },
  { have A : ∀ (i : ι), i ∈ (finset.univ : finset ι) → edist (f i) (g i) ^ p < ⊤ :=
      λ i hi, by simp [lt_top_iff_ne_top, edist_ne_top, le_of_lt pos],
    simp [dist, -one_div, pi_Lp.edist, ← ennreal.to_real_rpow,
          ennreal.to_real_sum A, dist_edist] }
end

protected lemma dist {p : ℝ} {hp : 1 ≤ p} {β : ι → Type*}
  [∀ i, pseudo_metric_space (β i)] (x y : pi_Lp p hp β) :
  dist x y = (∑ (i : ι), (dist (x i) (y i)) ^ p) ^ (1/p) := rfl

/-- seminormed group instance on the product of finitely many normed groups, using the `L^p`
norm. -/
instance semi_normed_group [∀i, semi_normed_group (β i)] : semi_normed_group (pi_Lp p hp β) :=
{ norm := λf, (∑ (i : ι), norm (f i) ^ p) ^ (1/p),
  dist_eq := λ x y, by { simp [pi_Lp.dist, dist_eq_norm, sub_eq_add_neg] },
  .. pi.add_comm_group }

/-- normed group instance on the product of finitely many normed groups, using the `L^p` norm. -/
instance normed_group [∀i, normed_group (α i)] : normed_group (pi_Lp p hp α) :=
{ ..pi_Lp.semi_normed_group p hp α }

lemma norm_eq {p : ℝ} {hp : 1 ≤ p} {β : ι → Type*}
  [∀i, semi_normed_group (β i)] (f : pi_Lp p hp β) :
  ∥f∥ = (∑ (i : ι), ∥f i∥ ^ p) ^ (1/p) := rfl

lemma norm_eq_of_nat {p : ℝ} {hp : 1 ≤ p} {β : ι → Type*}
  [∀i, semi_normed_group (β i)] (n : ℕ) (h : p = n) (f : pi_Lp p hp β) :
  ∥f∥ = (∑ (i : ι), ∥f i∥ ^ n) ^ (1/(n : ℝ)) :=
by simp [norm_eq, h, real.sqrt_eq_rpow, ←real.rpow_nat_cast]

variables (𝕜 : Type*) [normed_field 𝕜]

/-- The product of finitely many seminormed spaces is a seminormed space, with the `L^p` norm. -/
instance semi_normed_space [∀i, semi_normed_group (β i)] [∀i, semi_normed_space 𝕜 (β i)] :
  semi_normed_space 𝕜 (pi_Lp p hp β) :=
{ norm_smul_le :=
  begin
    assume c f,
    have : p * (1 / p) = 1 := mul_div_cancel' 1 (ne_of_gt (lt_of_lt_of_le zero_lt_one hp)),
    simp only [pi_Lp.norm_eq, norm_smul, mul_rpow, norm_nonneg, ←finset.mul_sum, pi.smul_apply],
    rw [mul_rpow (rpow_nonneg_of_nonneg (norm_nonneg _) _), ← rpow_mul (norm_nonneg _),
        this, rpow_one],
    exact finset.sum_nonneg (λ i hi, rpow_nonneg_of_nonneg (norm_nonneg _) _)
  end,
  .. pi.module ι β 𝕜 }

/-- The product of finitely many normed spaces is a normed space, with the `L^p` norm. -/
instance normed_space [∀i, normed_group (α i)] [∀i, normed_space 𝕜 (α i)] :
  normed_space 𝕜 (pi_Lp p hp α) :=
{ ..pi_Lp.semi_normed_space p hp α 𝕜 }

/- Register simplification lemmas for the applications of `pi_Lp` elements, as the usual lemmas
for Pi types will not trigger. -/
variables {𝕜 p hp α}
[∀i, semi_normed_group (β i)] [∀i, semi_normed_space 𝕜 (β i)] (c : 𝕜) (x y : pi_Lp p hp β) (i : ι)

@[simp] lemma add_apply : (x + y) i = x i + y i := rfl
@[simp] lemma sub_apply : (x - y) i = x i - y i := rfl
@[simp] lemma smul_apply : (c • x) i = c • x i := rfl
@[simp] lemma neg_apply : (-x) i = - (x i) := rfl

end pi_Lp


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import combinatorics.quiver.basic
import combinatorics.quiver.path
import combinatorics.quiver.push
import data.sum.basic
/-!
## Symmetric quivers and arrow reversal

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

This file contains constructions related to symmetric quivers:

* `symmetrify V` adds formal inverses to each arrow of `V`.
* `has_reverse` is the class of quivers where each arrow has an assigned formal inverse.
* `has_involutive_reverse` extends `has_reverse` by requiring that the reverse of the reverse
  is equal to the original arrow.
* `prefunctor.preserve_reverse` is the class of prefunctors mapping reverses to reverses.
* `symmetrify.of`, `symmetrify.lift`, and the associated lemmas witness the universal property
  of `symmetrify`.
-/

universes v u w v'

namespace quiver

/-- A type synonym for the symmetrized quiver (with an arrow both ways for each original arrow).
    NB: this does not work for `Prop`-valued quivers. It requires `[quiver.{v+1} V]`. -/
@[nolint has_nonempty_instance]
def symmetrify (V : Type*) := V

instance symmetrify_quiver (V : Type u) [quiver V] : quiver (symmetrify V) :=
⟨λ a b : V, (a ⟶ b) ⊕ (b ⟶ a)⟩

variables (U V W : Type*) [quiver.{u+1} U] [quiver.{v+1} V] [quiver.{w+1} W]

/-- A quiver `has_reverse` if we can reverse an arrow `p` from `a` to `b` to get an arrow
    `p.reverse` from `b` to `a`.-/
class has_reverse :=
(reverse' : Π {a b : V}, (a ⟶ b) → (b ⟶ a))

/-- Reverse the direction of an arrow. -/
def reverse {V} [quiver.{v+1} V] [has_reverse V] {a b : V} : (a ⟶ b) → (b ⟶ a) :=
has_reverse.reverse'

/-- A quiver `has_involutive_reverse` if reversing twice is the identity.`-/
class has_involutive_reverse extends has_reverse V :=
(inv' : Π {a b : V} (f : a ⟶ b), reverse (reverse f) = f)

variables {U V W}

@[simp] lemma reverse_reverse [h : has_involutive_reverse V]
  {a b : V} (f : a ⟶ b) : reverse (reverse f) = f := h.inv' f

@[simp] lemma reverse_inj [has_involutive_reverse V]
  {a b : V} (f g : a ⟶ b) : reverse f = reverse g ↔ f = g :=
begin
  split,
  { rintro h, simpa using congr_arg quiver.reverse h, },
  { rintro h, congr, assumption, },
end

lemma eq_reverse_iff [has_involutive_reverse V]
  {a b : V} (f : a ⟶ b) (g : b ⟶ a) : f = reverse g ↔ reverse f = g :=
by rw [←reverse_inj, reverse_reverse]

section map_reverse

variables [has_reverse U] [has_reverse V] [has_reverse W]

/-- A prefunctor preserving reversal of arrows -/
class _root_.prefunctor.map_reverse (φ : U ⥤q V) :=
(map_reverse' : ∀ {u v : U} (e : u ⟶ v), φ.map (reverse e) = reverse (φ.map e))

@[simp] lemma _root_.prefunctor.map_reverse' (φ : U ⥤q V) [φ.map_reverse] {u v : U} (e : u ⟶ v) :
  φ.map (reverse e) = reverse (φ.map e) :=
prefunctor.map_reverse.map_reverse' e

instance _root_.prefunctor.map_reverse_comp (φ : U ⥤q V) (ψ : V ⥤q W)
  [φ.map_reverse] [ψ.map_reverse] : (φ ⋙q ψ).map_reverse :=
{ map_reverse' := λ u v e, by { simp only [prefunctor.comp_map, prefunctor.map_reverse'], } }

instance _root_.prefunctor.map_reverse_id : (prefunctor.id U).map_reverse :=
{ map_reverse' := λ u v e, rfl }

end map_reverse

instance : has_reverse (symmetrify V) := ⟨λ a b e, e.swap⟩
instance : has_involutive_reverse (symmetrify V) :=
{ reverse' := λ _ _ e, e.swap,
  inv' := λ _ _ e, congr_fun sum.swap_swap_eq e }

@[simp] lemma symmetrify_reverse {a b : symmetrify V} (e : a ⟶ b) :
  reverse e = e.swap := rfl

/-- Shorthand for the "forward" arrow corresponding to `f` in `symmetrify V` -/
abbreviation hom.to_pos {X Y : V} (f : X ⟶ Y) :
  (quiver.symmetrify_quiver V).hom X Y := sum.inl f

/-- Shorthand for the "backward" arrow corresponding to `f` in `symmetrify V` -/
abbreviation hom.to_neg {X Y : V} (f : X ⟶ Y) :
  (quiver.symmetrify_quiver V).hom Y X := sum.inr f

/-- Reverse the direction of a path. -/
@[simp] def path.reverse [has_reverse V] {a : V} : Π {b}, path a b → path b a
| a path.nil := path.nil
| b (path.cons p e) := (reverse e).to_path.comp p.reverse

@[simp] lemma path.reverse_to_path [has_reverse V] {a b : V} (f : a ⟶ b) :
  f.to_path.reverse = (reverse f).to_path := rfl

@[simp] lemma path.reverse_comp [has_reverse V] {a b c : V} (p : path a b) (q : path b c) :
  (p.comp q).reverse = q.reverse.comp p.reverse := by
{ induction q, { simp, }, { simp [q_ih], }, }

@[simp] lemma path.reverse_reverse [has_involutive_reverse V] {a b : V} (p : path a b) :
  p.reverse.reverse = p :=
begin
  induction p,
  { simp, },
  { simp only [path.reverse, path.reverse_comp, path.reverse_to_path, reverse_reverse, p_ih],
    refl, },
end

namespace symmetrify

/-- The inclusion of a quiver in its symmetrification -/
@[simps] def of : V ⥤q symmetrify V :=
{ obj := id,
  map := λ X Y f, sum.inl f }

variables {V' : Type*} [quiver.{v'+1} V']

/-- Given a quiver `V'` with reversible arrows, a prefunctor to `V'` can be lifted to one from
    `symmetrify V` to `V'` -/
def lift [has_reverse V'] (φ : V ⥤q V') :
  (symmetrify V) ⥤q V' :=
{ obj := φ.obj,
  map := λ X Y f, sum.rec (λ fwd, φ.map fwd) (λ bwd, reverse (φ.map bwd)) f }

lemma lift_reverse [h : has_involutive_reverse V']
  (φ : V ⥤q V')
  {X Y : symmetrify V} (f : X ⟶ Y) :
  (lift φ).map (quiver.reverse f) = quiver.reverse ((lift φ).map f) :=
begin
  dsimp [lift], cases f,
  { simp only, refl, },
  { simp only [reverse_reverse], refl, }
end

/-- `lift φ` is the only prefunctor extending `φ` and preserving reverses. -/
lemma lift_unique [has_reverse V']
  (φ : V ⥤q V')
  (Φ : (symmetrify V) ⥤q V')
  (hΦ : of ⋙q Φ = φ) [hΦrev : Φ.map_reverse] :
  Φ = lift φ :=
begin
  subst_vars,
  fapply prefunctor.ext,
  { rintro X, refl, },
  { rintros X Y f,
    cases f,
    { refl, },
    { dsimp [lift,of],
      simp only [←prefunctor.map_reverse', symmetrify_reverse, sum.swap_inl], }, },
end

/-- A prefunctor canonically defines a prefunctor of the symmetrifications. -/
@[simps] def _root_.prefunctor.symmetrify (φ : U ⥤q V) : (symmetrify U) ⥤q (symmetrify V) :=
{ obj := φ.obj,
  map := λ X Y, sum.map φ.map φ.map }

instance _root_.prefunctor.symmetrify_map_reverse (φ : U ⥤q V) :
  prefunctor.map_reverse φ.symmetrify := ⟨λ u v e, by { cases e; refl }⟩

end symmetrify

namespace push

variables {V' : Type*} (σ : V → V')

instance [has_reverse V] : has_reverse (push σ) :=
{ reverse' := λ a b F, by { cases F, constructor, apply reverse, exact F_f, } }

instance [has_involutive_reverse V] : has_involutive_reverse (push σ) :=
{ reverse' := λ a b F, by { cases F, constructor, apply reverse, exact F_f, },
  inv' :=  λ a b F, by { cases F, dsimp [reverse], congr, apply reverse_reverse, } }

lemma of_reverse [h : has_involutive_reverse V]  (X Y : V) (f : X ⟶ Y):
  (reverse $ ((push.of σ)).map f) = ((push.of σ)).map (reverse f) := rfl

instance of_map_reverse [h : has_involutive_reverse V] : (push.of σ).map_reverse :=
⟨ by simp [of_reverse] ⟩

end push

/--
A quiver is preconnected iff there exists a path between any pair of
vertices.
Note that if `V` doesn't `has_reverse`, then the definition is stronger than
simply having a preconnected underlying `simple_graph`, since a path in one
direction doesn't induce one in the other.
-/
def is_preconnected (V) [quiver.{u+1} V] := ∀ (X Y : V), nonempty (path X Y)

end quiver


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import algebra.order.floor
import topology.algebra.ordered.basic

/-!
# Topological facts about `int.floor`, `int.ceil` and `int.fract`

This file proves statements about limits and continuity of functions involving `floor`, `ceil` and
`fract`.

## Main declarations

* `tendsto_floor_at_top`, `tendsto_floor_at_bot`, `tendsto_ceil_at_top`, `tendsto_ceil_at_bot`:
  `int.floor` and `int.ceil` tend to +-∞ in +-∞.
* `continuous_on_floor`: `int.floor` is continuous on `Ico n (n + 1)`, because constant.
* `continuous_on_ceil`: `int.ceil` is continuous on `Ioc n (n + 1)`, because constant.
* `continuous_on_fract`: `int.fract` is continuous on `Ico n (n + 1)`.
* `continuous_on.comp_fract`: Precomposing a continuous function satisfying `f 0 = f 1` with
  `int.fract` yields another continuous function.
-/

open filter function int set
open_locale topological_space

variables {α β γ : Type*} [linear_ordered_ring α] [floor_ring α]

lemma tendsto_floor_at_top : tendsto (floor : α → ℤ) at_top at_top :=
floor_mono.tendsto_at_top_at_top $ λ b, ⟨(b + 1 : ℤ), by { rw floor_coe, exact (lt_add_one _).le }⟩

lemma tendsto_floor_at_bot : tendsto (floor : α → ℤ) at_bot at_bot :=
floor_mono.tendsto_at_bot_at_bot $ λ b, ⟨b, (floor_coe _).le⟩

lemma tendsto_ceil_at_top : tendsto (ceil : α → ℤ) at_top at_top :=
ceil_mono.tendsto_at_top_at_top $ λ b, ⟨b, (ceil_coe _).ge⟩

lemma tendsto_ceil_at_bot : tendsto (ceil : α → ℤ) at_bot at_bot :=
ceil_mono.tendsto_at_bot_at_bot $ λ b, ⟨(b - 1 : ℤ), by { rw ceil_coe, exact (sub_one_lt _).le }⟩

variables [topological_space α]

lemma continuous_on_floor (n : ℤ) : continuous_on (λ x, floor x : α → α) (Ico n (n+1) : set α) :=
(continuous_on_congr $ floor_eq_on_Ico' n).mpr continuous_on_const

lemma continuous_on_ceil (n : ℤ) : continuous_on (λ x, ceil x : α → α) (Ioc (n-1) n : set α) :=
(continuous_on_congr $ ceil_eq_on_Ioc' n).mpr continuous_on_const

lemma tendsto_floor_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[≥] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Ici (lt_add_one (n : α)),
  simpa only [floor_coe] using
    (continuous_on_floor n _ (left_mem_Ico.mpr $ lt_add_one (_ : α))).tendsto
end

lemma tendsto_ceil_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[≤] n) (𝓝 n) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Iic (sub_one_lt (n : α)),
  simpa only [ceil_coe] using
    (continuous_on_ceil _ _ (right_mem_Ioc.mpr $ sub_one_lt (_ : α))).tendsto
end

lemma tendsto_floor_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[≥] n) (𝓝[≥] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_floor_right' _)
begin
  refine (eventually_nhds_within_of_forall $ λ x (hx : (n : α) ≤ x), _),
  change _ ≤ _,
  norm_cast,
  convert ← floor_mono hx,
  rw floor_eq_iff,
  exact ⟨le_rfl, lt_add_one _⟩
end

lemma tendsto_ceil_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[≤] n) (𝓝[≤] n) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ (tendsto_ceil_left' _)
begin
  refine (eventually_nhds_within_of_forall $ λ x (hx : x ≤ (n : α)), _),
  change _ ≤ _,
  norm_cast,
  convert ← ceil_mono hx,
  rw ceil_eq_iff,
  exact ⟨sub_one_lt _, le_rfl⟩
end

lemma tendsto_floor_left [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[<] n) (𝓝[≤] (n-1)) :=
begin
  rw ← nhds_within_Ico_eq_nhds_within_Iio (sub_one_lt (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (floor_eq_on_Ico' (n-1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Iic.mpr $ le_rfl)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_ceil_right [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[>] n) (𝓝[≥] (n+1)) :=
begin
  rw ← nhds_within_Ioc_eq_nhds_within_Ioi (lt_add_one (n : α)),
  convert (tendsto_nhds_within_congr $ (λ x hx, (ceil_eq_on_Ioc' (n+1) x hx).symm))
    (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ tendsto_const_nhds
      (eventually_of_forall (λ _, mem_Ici.mpr $ le_rfl)));
  norm_cast <|> apply_instance,
  ring
end

lemma tendsto_floor_left' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, floor x : α → α) (𝓝[<] n) (𝓝 (n-1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_floor_left n),
end

lemma tendsto_ceil_right' [order_closed_topology α] (n : ℤ) :
  tendsto (λ x, ceil x : α → α) (𝓝[>] n) (𝓝 (n+1)) :=
begin
  rw ← nhds_within_univ,
  exact tendsto_nhds_within_mono_right (subset_univ _) (tendsto_ceil_right n),
end

lemma continuous_on_fract [topological_add_group α] (n : ℤ) :
  continuous_on (fract : α → α) (Ico n (n+1) : set α) :=
continuous_on_id.sub (continuous_on_floor n)

lemma tendsto_fract_left' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[<] n) (𝓝 1) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_left' n);
  [{norm_cast, ring}, apply_instance, apply_instance]
end

lemma tendsto_fract_left [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[<] n) (𝓝[<] 1) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_left' _) (eventually_of_forall fract_lt_one)

lemma tendsto_fract_right' [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[≥] n) (𝓝 0) :=
begin
  convert (tendsto_nhds_within_of_tendsto_nhds tendsto_id).sub (tendsto_floor_right' n);
  [exact (sub_self _).symm, apply_instance, apply_instance]
end

lemma tendsto_fract_right [order_closed_topology α] [topological_add_group α]
  (n : ℤ) : tendsto (fract : α → α) (𝓝[≥] n) (𝓝[≥] 0) :=
tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
  (tendsto_fract_right' _) (eventually_of_forall fract_nonneg)

local notation `I` := (Icc 0 1 : set α)

variables [order_topology α] [topological_add_group α] [topological_space β] [topological_space γ]

/-- Do not use this, use `continuous_on.comp_fract` instead. -/
lemma continuous_on.comp_fract' {f : β → α → γ}
  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ I) (hf : ∀ s, f s 0 = f s 1) :
  continuous (λ st : β × α, f st.1 $ fract st.2) :=
begin
  change continuous ((uncurry f) ∘ (prod.map id (fract))),
  rw continuous_iff_continuous_at,
  rintro ⟨s, t⟩,
  by_cases ht : t = floor t,
  { rw ht,
    rw ← continuous_within_at_univ,
    have : (univ : set (β × α)) ⊆ ((univ : set β) ×ˢ Iio ↑⌊t⌋) ∪ ((univ : set β) ×ˢ Ici ↑⌊t⌋),
    { rintros p -,
      rw ← prod_union,
      exact ⟨trivial, lt_or_le p.2 _⟩ },
    refine continuous_within_at.mono _ this,
    refine continuous_within_at.union _ _,
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      have : (uncurry f) (s, 0) = (uncurry f) (s, (1 : α)),
        by simp [uncurry, hf],
      rw this,
      refine (h _ ⟨true.intro, by exact_mod_cast right_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ],
      rw nhds_within_Icc_eq_nhds_within_Iic (@zero_lt_one α _ _),
      exact tendsto_id.prod_map
        (tendsto_nhds_within_mono_right Iio_subset_Iic_self $ tendsto_fract_left _) },
    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
                  nhds_within_univ, id.def, comp_app, prod.map_mk],
      refine (h _ ⟨true.intro, by exact_mod_cast left_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
      rw [nhds_within_prod_eq, nhds_within_univ,
        nhds_within_Icc_eq_nhds_within_Ici (@zero_lt_one α _ _)],
      exact tendsto_id.prod_map (tendsto_fract_right _) } },
  { have : t ∈ Ioo (floor t : α) ((floor t : α) + 1),
      from ⟨lt_of_le_of_ne (floor_le t) (ne.symm ht), lt_floor_add_one _⟩,
    apply (h ((prod.map _ fract) _) ⟨trivial, ⟨fract_nonneg _, (fract_lt_one _).le⟩⟩).tendsto.comp,
    simp only [nhds_prod_eq, nhds_within_prod_eq, nhds_within_univ, id.def, prod.map_mk],
    exact continuous_at_id.tendsto.prod_map
            (tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
              (((continuous_on_fract _ _ (Ioo_subset_Ico_self this)).mono
                  Ioo_subset_Ico_self).continuous_at (Ioo_mem_nhds this.1 this.2))
              (eventually_of_forall (λ x, ⟨fract_nonneg _, (fract_lt_one _).le⟩)) ) }
end

lemma continuous_on.comp_fract
  {s : β → α}
  {f : β → α → γ}
  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ (Icc 0 1 : set α))
  (hs : continuous s)
  (hf : ∀ s, f s 0 = f s 1) :
  continuous (λ x : β, f x $ int.fract (s x)) :=
(h.comp_fract' hf).comp (continuous_id.prod_mk hs)

/-- A special case of `continuous_on.comp_fract`. -/
lemma continuous_on.comp_fract'' {f : α → β} (h : continuous_on f I) (hf : f 0 = f 1) :
  continuous (f ∘ fract) :=
continuous_on.comp_fract (h.comp continuous_on_snd $ λ x hx, (mem_prod.mp hx).2)
  continuous_id (λ _, hf)


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang

! This file was ported from Lean 3 source module data.polynomial.module
! leanprover-community/mathlib commit 63417e01fbc711beaf25fa73b6edb395c0cfddd0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.FiniteType

/-!
# Polynomial module

In this file, we define the polynomial module for an `R`-module `M`, i.e. the `R[X]`-module `M[X]`.

This is defined as an type alias `polynomial_module R M := ℕ →₀ M`, since there might be different
module structures on `ℕ →₀ M` of interest. See the docstring of `polynomial_module` for details.

-/

universe u v

open Polynomial

open Polynomial BigOperators

variable (R M : Type _) [CommRing R] [AddCommGroup M] [Module R M] (I : Ideal R)

include R

/-- The `R[X]`-module `M[X]` for an `R`-module `M`.
This is isomorphic (as an `R`-module) to `M[X]` when `M` is a ring.

We require all the module instances `module S (polynomial_module R M)` to factor through `R` except
`module R[X] (polynomial_module R M)`.
In this constraint, we have the following instances for example :
- `R` acts on `polynomial_module R R[X]`
- `R[X]` acts on `polynomial_module R R[X]` as `R[Y]` acting on `R[X][Y]`
- `R` acts on `polynomial_module R[X] R[X]`
- `R[X]` acts on `polynomial_module R[X] R[X]` as `R[X]` acting on `R[X][Y]`
- `R[X][X]` acts on `polynomial_module R[X] R[X]` as `R[X][Y]` acting on itself

This is also the reason why `R` is included in the alias, or else there will be two different
instances of `module R[X] (polynomial_module R[X])`.

See https://leanprover.zulipchat.com/#narrow/stream/144837-PR-reviews/topic/.2315065.20polynomial.20modules
for the full discussion.
-/
@[nolint unused_arguments]
def PolynomialModule :=
  ℕ →₀ M deriving AddCommGroup, Inhabited
#align polynomial_module PolynomialModule

omit R

variable {M}

variable {S : Type _} [CommSemiring S] [Algebra S R] [Module S M] [IsScalarTower S R M]

namespace PolynomialModule

/-- This is required to have the `is_scalar_tower S R M` instance to avoid diamonds. -/
@[nolint unused_arguments]
noncomputable instance : Module S (PolynomialModule R M) :=
  Finsupp.module ℕ M

instance : CoeFun (PolynomialModule R M) fun _ => ℕ → M :=
  Finsupp.coeFun

/-- The monomial `m * x ^ i`. This is defeq to `finsupp.single_add_hom`, and is redefined here
so that it has the desired type signature.  -/
noncomputable def single (i : ℕ) : M →+ PolynomialModule R M :=
  Finsupp.singleAddHom i
#align polynomial_module.single PolynomialModule.single

theorem single_apply (i : ℕ) (m : M) (n : ℕ) : single R i m n = ite (i = n) m 0 :=
  Finsupp.single_apply
#align polynomial_module.single_apply PolynomialModule.single_apply

/-- `polynomial_module.single` as a linear map. -/
noncomputable def lsingle (i : ℕ) : M →ₗ[R] PolynomialModule R M :=
  Finsupp.lsingle i
#align polynomial_module.lsingle PolynomialModule.lsingle

theorem lsingle_apply (i : ℕ) (m : M) (n : ℕ) : lsingle R i m n = ite (i = n) m 0 :=
  Finsupp.single_apply
#align polynomial_module.lsingle_apply PolynomialModule.lsingle_apply

theorem single_smul (i : ℕ) (r : R) (m : M) : single R i (r • m) = r • single R i m :=
  (lsingle R i).map_smul r m
#align polynomial_module.single_smul PolynomialModule.single_smul

variable {R}

theorem induction_linear {P : PolynomialModule R M → Prop} (f : PolynomialModule R M) (h0 : P 0)
    (hadd : ∀ f g, P f → P g → P (f + g)) (hsingle : ∀ a b, P (single R a b)) : P f :=
  Finsupp.induction_linear f h0 hadd hsingle
#align polynomial_module.induction_linear PolynomialModule.induction_linear

@[semireducible]
noncomputable instance polynomialModule : Module R[X] (PolynomialModule R M) :=
  modulePolynomialOfEndo (Finsupp.lmapDomain _ _ Nat.succ)
#align polynomial_module.polynomial_module PolynomialModule.polynomialModule

instance (M : Type u) [AddCommGroup M] [Module R M] [Module S M] [IsScalarTower S R M] :
    IsScalarTower S R (PolynomialModule R M) :=
  Finsupp.isScalarTower _ _

instance is_scalar_tower' (M : Type u) [AddCommGroup M] [Module R M] [Module S M]
    [IsScalarTower S R M] : IsScalarTower S R[X] (PolynomialModule R M) :=
  by
  haveI : IsScalarTower R R[X] (PolynomialModule R M) := modulePolynomialOfEndo.isScalarTower _
  constructor
  intro x y z
  rw [← @IsScalarTower.algebraMap_smul S R, ← @IsScalarTower.algebraMap_smul S R, smul_assoc]
#align polynomial_module.is_scalar_tower' PolynomialModule.is_scalar_tower'

@[simp]
theorem monomial_smul_single (i : ℕ) (r : R) (j : ℕ) (m : M) :
    monomial i r • single R j m = single R (i + j) (r • m) :=
  by
  simp only [LinearMap.mul_apply, Polynomial.aeval_monomial, LinearMap.pow_apply,
    Module.algebraMap_end_apply, modulePolynomialOfEndo_smul_def]
  induction i generalizing r j m
  · simp [single]
  · rw [Function.iterate_succ, Function.comp_apply, Nat.succ_eq_add_one, add_assoc, ← i_ih]
    congr 2
    ext a
    dsimp [single]
    rw [Finsupp.mapDomain_single, Nat.succ_eq_one_add]
#align polynomial_module.monomial_smul_single PolynomialModule.monomial_smul_single

@[simp]
theorem monomial_smul_apply (i : ℕ) (r : R) (g : PolynomialModule R M) (n : ℕ) :
    (monomial i r • g) n = ite (i ≤ n) (r • g (n - i)) 0 :=
  by
  induction' g using PolynomialModule.induction_linear with p q hp hq
  · simp only [smul_zero, Finsupp.zero_apply, if_t_t]
  · simp only [smul_add, Finsupp.add_apply, hp, hq]
    split_ifs
    exacts[rfl, zero_add 0]
  · rw [monomial_smul_single, single_apply, single_apply, smul_ite, smul_zero, ← ite_and]
    congr
    rw [eq_iff_iff]
    constructor
    · rintro rfl
      simp
    · rintro ⟨e, rfl⟩
      rw [add_comm, tsub_add_cancel_of_le e]
#align polynomial_module.monomial_smul_apply PolynomialModule.monomial_smul_apply

@[simp]
theorem smul_single_apply (i : ℕ) (f : R[X]) (m : M) (n : ℕ) :
    (f • single R i m) n = ite (i ≤ n) (f.coeff (n - i) • m) 0 :=
  by
  induction' f using Polynomial.induction_on' with p q hp hq
  · rw [add_smul, Finsupp.add_apply, hp, hq, coeff_add, add_smul]
    split_ifs
    exacts[rfl, zero_add 0]
  · rw [monomial_smul_single, single_apply, coeff_monomial, ite_smul, zero_smul]
    by_cases h : i ≤ n
    · simp_rw [eq_tsub_iff_add_eq_of_le h, if_pos h]
    · rw [if_neg h, ite_eq_right_iff]
      intro e
      exfalso
      linarith
#align polynomial_module.smul_single_apply PolynomialModule.smul_single_apply

theorem smul_apply (f : R[X]) (g : PolynomialModule R M) (n : ℕ) :
    (f • g) n = ∑ x in Finset.Nat.antidiagonal n, f.coeff x.1 • g x.2 :=
  by
  induction' f using Polynomial.induction_on' with p q hp hq
  · rw [add_smul, Finsupp.add_apply, hp, hq, ← Finset.sum_add_distrib]
    congr
    ext
    rw [coeff_add, add_smul]
  · rw [Finset.Nat.sum_antidiagonal_eq_sum_range_succ fun i j => (monomial f_n f_a).coeff i • g j,
      monomial_smul_apply]
    dsimp [monomial]
    simp_rw [Finsupp.single_smul, Finsupp.single_apply]
    rw [Finset.sum_ite_eq]
    simp [Nat.lt_succ_iff]
#align polynomial_module.smul_apply PolynomialModule.smul_apply

/-- `polynomial_module R R` is isomorphic to `R[X]` as an `R[X]` module. -/
noncomputable def equivPolynomialSelf : PolynomialModule R R ≃ₗ[R[X]] R[X] :=
  { (Polynomial.toFinsuppIso R).symm with
    map_smul' := fun r x =>
      by
      induction' r using Polynomial.induction_on' with _ _ _ _ n p
      · simp_all only [add_smul, map_add, [anonymous]]
      · ext i
        dsimp
        rw [monomial_smul_apply, ← Polynomial.C_mul_X_pow_eq_monomial, mul_assoc,
          Polynomial.coeff_C_mul, Polynomial.coeff_X_pow_mul', mul_ite, MulZeroClass.mul_zero]
        simp }
#align polynomial_module.equiv_polynomial_self PolynomialModule.equivPolynomialSelf

/-- `polynomial_module R S` is isomorphic to `S[X]` as an `R` module. -/
noncomputable def equivPolynomial {S : Type _} [CommRing S] [Algebra R S] :
    PolynomialModule R S ≃ₗ[R] S[X] :=
  { (Polynomial.toFinsuppIso S).symm with map_smul' := fun r x => rfl }
#align polynomial_module.equiv_polynomial PolynomialModule.equivPolynomial

variable (R' : Type _) {M' : Type _} [CommRing R'] [AddCommGroup M'] [Module R' M']

variable [Algebra R R'] [Module R M'] [IsScalarTower R R' M']

/-- The image of a polynomial under a linear map. -/
noncomputable def map (f : M →ₗ[R] M') : PolynomialModule R M →ₗ[R] PolynomialModule R' M' :=
  Finsupp.mapRange.linearMap f
#align polynomial_module.map PolynomialModule.map

@[simp]
theorem map_single (f : M →ₗ[R] M') (i : ℕ) (m : M) : map R' f (single R i m) = single R' i (f m) :=
  Finsupp.mapRange_single
#align polynomial_module.map_single PolynomialModule.map_single

theorem map_smul (f : M →ₗ[R] M') (p : R[X]) (q : PolynomialModule R M) :
    map R' f (p • q) = p.map (algebraMap R R') • map R' f q :=
  by
  apply induction_linear q
  · rw [smul_zero, map_zero, smul_zero]
  · intro f g e₁ e₂
    rw [smul_add, map_add, e₁, e₂, map_add, smul_add]
  intro i m
  apply Polynomial.induction_on' p
  · intro p q e₁ e₂
    rw [add_smul, map_add, e₁, e₂, Polynomial.map_add, add_smul]
  · intro j s
    rw [monomial_smul_single, map_single, Polynomial.map_monomial, map_single, monomial_smul_single,
      f.map_smul, algebraMap_smul]
#align polynomial_module.map_smul PolynomialModule.map_smul

/-- Evaulate a polynomial `p : polynomial_module R M` at `r : R`. -/
@[simps (config := lemmasOnly)]
def eval (r : R) : PolynomialModule R M →ₗ[R] M
    where
  toFun p := p.Sum fun i m => r ^ i • m
  map_add' x y := Finsupp.sum_add_index' (fun _ => smul_zero _) fun _ _ _ => smul_add _ _ _
  map_smul' s m := by
    refine' (Finsupp.sum_smul_index' _).trans _
    · exact fun i => smul_zero _
    · simp_rw [← smul_comm s, ← Finsupp.smul_sum]
      rfl
#align polynomial_module.eval PolynomialModule.eval

@[simp]
theorem eval_single (r : R) (i : ℕ) (m : M) : eval r (single R i m) = r ^ i • m :=
  Finsupp.sum_single_index (smul_zero _)
#align polynomial_module.eval_single PolynomialModule.eval_single

@[simp]
theorem eval_lsingle (r : R) (i : ℕ) (m : M) : eval r (lsingle R i m) = r ^ i • m :=
  eval_single r i m
#align polynomial_module.eval_lsingle PolynomialModule.eval_lsingle

theorem eval_smul (p : R[X]) (q : PolynomialModule R M) (r : R) :
    eval r (p • q) = p.eval r • eval r q :=
  by
  apply induction_linear q
  · rw [smul_zero, map_zero, smul_zero]
  · intro f g e₁ e₂
    rw [smul_add, map_add, e₁, e₂, map_add, smul_add]
  intro i m
  apply Polynomial.induction_on' p
  · intro p q e₁ e₂
    rw [add_smul, map_add, Polynomial.eval_add, e₁, e₂, add_smul]
  · intro j s
    rw [monomial_smul_single, eval_single, Polynomial.eval_monomial, eval_single, smul_comm, ←
      smul_smul, pow_add, mul_smul]
#align polynomial_module.eval_smul PolynomialModule.eval_smul

@[simp]
theorem eval_map (f : M →ₗ[R] M') (q : PolynomialModule R M) (r : R) :
    eval (algebraMap R R' r) (map R' f q) = f (eval r q) :=
  by
  apply induction_linear q
  · simp_rw [map_zero]
  · intro f g e₁ e₂
    simp_rw [map_add, e₁, e₂]
  · intro i m
    rw [map_single, eval_single, eval_single, f.map_smul, ← map_pow, algebraMap_smul]
#align polynomial_module.eval_map PolynomialModule.eval_map

@[simp]
theorem eval_map' (f : M →ₗ[R] M) (q : PolynomialModule R M) (r : R) :
    eval r (map R f q) = f (eval r q) :=
  eval_map R f q r
#align polynomial_module.eval_map' PolynomialModule.eval_map'

/-- `comp p q` is the composition of `p : R[X]` and `q : M[X]` as `q(p(x))`.  -/
@[simps]
noncomputable def comp (p : R[X]) : PolynomialModule R M →ₗ[R] PolynomialModule R M :=
  ((eval p).restrictScalars R).comp (map R[X] (lsingle R 0))
#align polynomial_module.comp PolynomialModule.comp

theorem comp_single (p : R[X]) (i : ℕ) (m : M) : comp p (single R i m) = p ^ i • single R 0 m :=
  by
  rw [comp_apply]
  erw [map_single, eval_single]
  rfl
#align polynomial_module.comp_single PolynomialModule.comp_single

theorem comp_eval (p : R[X]) (q : PolynomialModule R M) (r : R) :
    eval r (comp p q) = eval (p.eval r) q :=
  by
  rw [← LinearMap.comp_apply]
  apply induction_linear q
  · rw [map_zero, map_zero]
  · intro _ _ e₁ e₂
    rw [map_add, map_add, e₁, e₂]
  · intro i m
    rw [LinearMap.comp_apply, comp_single, eval_single, eval_smul, eval_single, pow_zero, one_smul,
      Polynomial.eval_pow]
#align polynomial_module.comp_eval PolynomialModule.comp_eval

theorem comp_smul (p p' : R[X]) (q : PolynomialModule R M) :
    comp p (p' • q) = p'.comp p • comp p q :=
  by
  rw [comp_apply, map_smul, eval_smul, Polynomial.comp, Polynomial.eval_map, comp_apply]
  rfl
#align polynomial_module.comp_smul PolynomialModule.comp_smul

end PolynomialModule


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

! This file was ported from Lean 3 source module category_theory.functor.functorial
! leanprover-community/mathlib commit afad8e438d03f9d89da2914aa06cb4964ba87a18
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Basic

/-!
# Unbundled functors, as a typeclass decorating the object-level function.
-/

namespace CategoryTheory

-- declare the `v`'s first; see `CategoryTheory.Category` for an explanation
universe v v₁ v₂ v₃ u u₁ u₂ u₃

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

-- Perhaps in the future we could redefine `Functor` in terms of this, but that isn't the
-- immediate plan.
/-- A unbundled functor. -/
class Functorial (F : C → D) : Type max v₁ v₂ u₁ u₂ where
  /-- A functorial map extends to an action on morphisms. -/
  map' : ∀ {X Y : C}, (X ⟶ Y) → (F X ⟶ F Y)
  /-- A functorial map preserves identities. -/
  map_id' : ∀ X : C, map' (𝟙 X) = 𝟙 (F X) := by aesop_cat
  /-- A functorial map preserves composition of morphisms. -/
  map_comp' : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map' (f ≫ g) = map' f ≫ map' g := by
    aesop_cat
#align category_theory.functorial CategoryTheory.Functorial
#align category_theory.functorial.map CategoryTheory.Functorial.map'

/-- If `F : C → D` (just a function) has `[Functorial F]`,
we can write `map F f : F X ⟶ F Y` for the action of `F` on a morphism `f : X ⟶ Y`.
-/
def map (F : C → D) [Functorial.{v₁, v₂} F] {X Y : C} (f : X ⟶ Y) : F X ⟶ F Y :=
  Functorial.map'.{v₁, v₂} f
#align category_theory.map CategoryTheory.map

@[simp]
theorem map'_as_map {F : C → D} [Functorial.{v₁, v₂} F] {X Y : C} {f : X ⟶ Y} :
    Functorial.map'.{v₁, v₂} f = map F f :=
  rfl
#align category_theory.map_as_map CategoryTheory.map'_as_map

@[simp]
theorem Functorial.map_id {F : C → D} [Functorial.{v₁, v₂} F] {X : C} : map F (𝟙 X) = 𝟙 (F X) :=
  Functorial.map_id' X
#align category_theory.functorial.map_id CategoryTheory.Functorial.map_id

@[simp]
theorem Functorial.map_comp {F : C → D} [Functorial.{v₁, v₂} F] {X Y Z : C} {f : X ⟶ Y}
    {g : Y ⟶ Z} : map F (f ≫ g) = map F f ≫ map F g :=
  Functorial.map_comp' f g
#align category_theory.functorial.map_comp CategoryTheory.Functorial.map_comp

namespace Functor

/-- Bundle a functorial function as a functor.
-/
def of (F : C → D) [I : Functorial.{v₁, v₂} F] : C ⥤ D :=
  { I with obj := F
           map := map F }
#align category_theory.functor.of CategoryTheory.Functor.of

end Functor

instance (F : C ⥤ D) : Functorial.{v₁, v₂} F.obj :=
  { F with map' := F.map }

@[simp]
theorem map_functorial_obj (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) : map F.obj f = F.map f :=
  rfl
#align category_theory.map_functorial_obj CategoryTheory.map_functorial_obj

instance functorial_id : Functorial.{v₁, v₁} (id : C → C) where map' f := f
#align category_theory.functorial_id CategoryTheory.functorial_id

section

variable {E : Type u₃} [Category.{v₃} E]

-- This is no longer viable as an instance in Lean 3.7,
-- #lint reports an instance loop
-- Will this be a problem?
/-- `G ∘ F` is a functorial if both `F` and `G` are.
-/
def functorial_comp (F : C → D) [Functorial.{v₁, v₂} F] (G : D → E) [Functorial.{v₂, v₃} G] :
    Functorial.{v₁, v₃} (G ∘ F) :=
  { Functor.of F ⋙ Functor.of G with map' := fun f => map G (map F f) }
#align category_theory.functorial_comp CategoryTheory.functorial_comp

end

end CategoryTheory