/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.algebra.basic
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# Multiplication and division of submodules of an algebra.

An interface for multiplication and division of sub-R-modules of an R-algebra A is developed.

## Main definitions

Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra.

* `1 : submodule R A`       : the R-submodule R of the R-algebra A
* `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be
                              the smallest submodule containing all the products `m * n`.
* `has_div (submodule R A)` : `I / J` is defined to be the submodule consisting of all `a : A` such
                              that `a • J ⊆ I`

It is proved that `submodule R A` is a semiring, and also an algebra over `set A`.

## Tags

multiplication of submodules, division of subodules, submodule semiring
-/

namespace submodule

/-- `1 : submodule R A` is the submodule R of A. -/
protected instance has_one {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    HasOne (submodule R A) :=
  { one := map (alg_hom.to_linear_map (algebra.of_id R A)) ⊤ }

theorem one_eq_map_top {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    1 = map (alg_hom.to_linear_map (algebra.of_id R A)) ⊤ :=
  rfl

theorem one_eq_span {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    1 = span R (singleton 1) :=
  sorry

theorem one_le {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {P : submodule R A} : 1 ≤ P ↔ 1 ∈ P :=
  sorry

/-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the
smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/
protected instance has_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    Mul (submodule R A) :=
  { mul :=
      fun (M N : submodule R A) =>
        supr fun (s : ↥M) => map (coe_fn (algebra.lmul R A) (subtype.val s)) N }

theorem mul_mem_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {m : A} {n : A} (hm : m ∈ M) (hn : n ∈ N) :
    m * n ∈ M * N :=
  le_supr (fun (s : ↥M) => map (coe_fn (algebra.lmul R A) (subtype.val s)) N)
    { val := m, property := hm } (m * n) (Exists.intro n { left := hn, right := rfl })

theorem mul_le {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {P : submodule R A} :
    M * N ≤ P ↔ ∀ (m : A), m ∈ M → ∀ (n : A), n ∈ N → m * n ∈ P :=
  sorry

protected theorem mul_induction_on {R : Type u} [comm_semiring R] {A : Type v} [semiring A]
    [algebra R A] {M : submodule R A} {N : submodule R A} {C : A → Prop} {r : A} (hr : r ∈ M * N)
    (hm : ∀ (m : A), m ∈ M → ∀ (n : A), n ∈ N → C (m * n)) (h0 : C 0)
    (ha : ∀ (x y : A), C x → C y → C (x + y)) (hs : ∀ (r : R) (x : A), C x → C (r • x)) : C r :=
  iff.mpr mul_le hm r hr

theorem span_mul_span (R : Type u) [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (S : set A) (T : set A) : span R S * span R T = span R (S * T) :=
  sorry

protected theorem mul_assoc {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) (N : submodule R A) (P : submodule R A) : M * N * P = M * (N * P) :=
  sorry

@[simp] theorem mul_bot {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) : M * ⊥ = ⊥ :=
  sorry

@[simp] theorem bot_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) : ⊥ * M = ⊥ :=
  sorry

@[simp] protected theorem one_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A]
    [algebra R A] (M : submodule R A) : 1 * M = M :=
  sorry

@[simp] protected theorem mul_one {R : Type u} [comm_semiring R] {A : Type v} [semiring A]
    [algebra R A] (M : submodule R A) : M * 1 = M :=
  sorry

theorem mul_le_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {P : submodule R A} {Q : submodule R A} (hmp : M ≤ P)
    (hnq : N ≤ Q) : M * N ≤ P * Q :=
  iff.mpr mul_le fun (m : A) (hm : m ∈ M) (n : A) (hn : n ∈ N) => mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {P : submodule R A} (h : M ≤ N) : M * P ≤ N * P :=
  mul_le_mul h (le_refl P)

theorem mul_le_mul_right {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {P : submodule R A} (h : N ≤ P) : M * N ≤ M * P :=
  mul_le_mul (le_refl M) h

theorem mul_sup {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) (N : submodule R A) (P : submodule R A) : M * (N ⊔ P) = M * N ⊔ M * P :=
  sorry

theorem sup_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) (N : submodule R A) (P : submodule R A) : (M ⊔ N) * P = M * P ⊔ N * P :=
  sorry

theorem mul_subset_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) (N : submodule R A) : ↑M * ↑N ⊆ ↑(M * N) :=
  sorry

theorem map_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) (N : submodule R A) {A' : Type u_1} [semiring A'] [algebra R A']
    (f : alg_hom R A A') :
    map (alg_hom.to_linear_map f) (M * N) =
        map (alg_hom.to_linear_map f) M * map (alg_hom.to_linear_map f) N :=
  sorry

theorem mem_span_mul_finite_of_mem_span_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A]
    [algebra R A] {S : set A} {S' : set A} {x : A} (hx : x ∈ span R (S * S')) :
    ∃ (T : finset A), ∃ (T' : finset A), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ x ∈ span R (↑T * ↑T') :=
  sorry

theorem mem_span_mul_finite_of_mem_mul {R : Type u} [comm_semiring R] {A : Type v} [semiring A]
    [algebra R A] {P : submodule R A} {Q : submodule R A} {x : A} (hx : x ∈ P * Q) :
    ∃ (T : finset A), ∃ (T' : finset A), ↑T ⊆ ↑P ∧ ↑T' ⊆ ↑Q ∧ x ∈ span R (↑T * ↑T') :=
  sorry

/-- Sub-R-modules of an R-algebra form a semiring. -/
protected instance semiring {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    semiring (submodule R A) :=
  semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry Mul.mul
    submodule.mul_assoc 1 submodule.one_mul submodule.mul_one bot_mul mul_bot mul_sup sup_mul

theorem pow_subset_pow {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A]
    (M : submodule R A) {n : ℕ} : ↑M ^ n ⊆ ↑(M ^ n) :=
  sorry

/-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets
on either side). -/
def span.ring_hom {R : Type u} [comm_semiring R] {A : Type v} [semiring A] [algebra R A] :
    set.set_semiring A →+* submodule R A :=
  ring_hom.mk (span R) sorry sorry sorry sorry

theorem mul_mem_mul_rev {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    {M : submodule R A} {N : submodule R A} {m : A} {n : A} (hm : m ∈ M) (hn : n ∈ N) :
    n * m ∈ M * N :=
  mul_comm m n ▸ mul_mem_mul hm hn

protected theorem mul_comm {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] (M : submodule R A) (N : submodule R A) : M * N = N * M :=
  le_antisymm
    (iff.mpr mul_le fun (r : A) (hrm : r ∈ M) (s : A) (hsn : s ∈ N) => mul_mem_mul_rev hsn hrm)
    (iff.mpr mul_le fun (r : A) (hrn : r ∈ N) (s : A) (hsm : s ∈ M) => mul_mem_mul_rev hsm hrn)

/-- Sub-R-modules of an R-algebra A form a semiring. -/
protected instance comm_semiring {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] : comm_semiring (submodule R A) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry
    semiring.one sorry sorry sorry sorry sorry sorry submodule.mul_comm

/-- R-submodules of the R-algebra A are a module over `set A`. -/
protected instance semimodule_set (R : Type u) [comm_semiring R] (A : Type v) [comm_semiring A]
    [algebra R A] : semimodule (set.set_semiring A) (submodule R A) :=
  semimodule.mk sorry sorry

theorem smul_def {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    {s : set.set_semiring A} {P : submodule R A} : s • P = span R s * P :=
  rfl

theorem smul_le_smul {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    {s : set.set_semiring A} {t : set.set_semiring A} {M : submodule R A} {N : submodule R A}
    (h₁ : set.set_semiring.down s ≤ set.set_semiring.down t) (h₂ : M ≤ N) : s • M ≤ t • N :=
  mul_le_mul (span_mono h₁) h₂

theorem smul_singleton {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    (a : A) (M : submodule R A) : set.up (singleton a) • M = map (algebra.lmul_left R a) M :=
  sorry

/-- The elements of `I / J` are the `x` such that `x • J ⊆ I`.

In fact, we define `x ∈ I / J` to be `∀ y ∈ J, x * y ∈ I` (see `mem_div_iff_forall_mul_mem`),
which is equivalent to `x • J ⊆ I` (see `mem_div_iff_smul_subset`), but nicer to use in proofs.

This is the general form of the ideal quotient, traditionally written $I : J$.
-/
protected instance has_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] : Div (submodule R A) :=
  { div :=
      fun (I J : submodule R A) =>
        mk (set_of fun (x : A) => ∀ (y : A), y ∈ J → x * y ∈ I) sorry sorry sorry }

theorem mem_div_iff_forall_mul_mem {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {x : A} {I : submodule R A} {J : submodule R A} :
    x ∈ I / J ↔ ∀ (y : A), y ∈ J → x * y ∈ I :=
  iff.refl (x ∈ I / J)

theorem mem_div_iff_smul_subset {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {x : A} {I : submodule R A} {J : submodule R A} : x ∈ I / J ↔ x • ↑J ⊆ ↑I :=
  sorry

theorem le_div_iff {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    {I : submodule R A} {J : submodule R A} {K : submodule R A} :
    I ≤ J / K ↔ ∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J :=
  iff.refl (I ≤ J / K)

theorem le_div_iff_mul_le {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {I : submodule R A} {J : submodule R A} {K : submodule R A} :
    I ≤ J / K ↔ I * K ≤ J :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ≤ J / K ↔ I * K ≤ J)) (propext le_div_iff)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl ((∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J) ↔ I * K ≤ J))
          (propext mul_le)))
      (iff.refl (∀ (x : A), x ∈ I → ∀ (z : A), z ∈ K → x * z ∈ J)))

@[simp] theorem one_le_one_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {I : submodule R A} : 1 ≤ 1 / I ↔ I ≤ 1 :=
  sorry

theorem le_self_mul_one_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {I : submodule R A} (hI : I ≤ 1) : I ≤ I * (1 / I) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (I ≤ I * (1 / I))) (Eq.symm (mul_one I))))
    (mul_le_mul_right (iff.mpr one_le_one_div hI))

theorem mul_one_div_le_one {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A]
    [algebra R A] {I : submodule R A} : I * (1 / I) ≤ 1 :=
  sorry

@[simp] theorem map_div {R : Type u} [comm_semiring R] {A : Type v} [comm_semiring A] [algebra R A]
    {B : Type u_1} [comm_ring B] [algebra R B] (I : submodule R A) (J : submodule R A)
    (h : alg_equiv R A B) :
    map (alg_equiv.to_linear_map h) (I / J) =
        map (alg_equiv.to_linear_map h) I / map (alg_equiv.to_linear_map h) J :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen,
  Frédéric Dupuis, Heather Macbeth
-/
import algebra.hom.group_action
import algebra.module.pi
import algebra.star.basic
import data.set.pointwise.smul
import algebra.ring.comp_typeclasses

/-!
# (Semi)linear maps

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

In this file we define

* `linear_map σ M M₂`, `M →ₛₗ[σ] M₂` : a semilinear map between two `module`s. Here,
  `σ` is a `ring_hom` from `R` to `R₂` and an `f : M →ₛₗ[σ] M₂` satisfies
  `f (c • x) = (σ c) • (f x)`. We recover plain linear maps by choosing `σ` to be `ring_hom.id R`.
  This is denoted by `M →ₗ[R] M₂`. We also add the notation `M →ₗ⋆[R] M₂` for star-linear maps.

* `is_linear_map R f` : predicate saying that `f : M → M₂` is a linear map. (Note that this
  was not generalized to semilinear maps.)

We then provide `linear_map` with the following instances:

* `linear_map.add_comm_monoid` and `linear_map.add_comm_group`: the elementwise addition structures
  corresponding to addition in the codomain
* `linear_map.distrib_mul_action` and `linear_map.module`: the elementwise scalar action structures
  corresponding to applying the action in the codomain.
* `module.End.semiring` and `module.End.ring`: the (semi)ring of endomorphisms formed by taking the
  additive structure above with composition as multiplication.

## Implementation notes

To ensure that composition works smoothly for semilinear maps, we use the typeclasses
`ring_hom_comp_triple`, `ring_hom_inv_pair` and `ring_hom_surjective` from
`algebra/ring/comp_typeclasses`.

## Notation

* Throughout the file, we denote regular linear maps by `fₗ`, `gₗ`, etc, and semilinear maps
  by `f`, `g`, etc.

## TODO

* Parts of this file have not yet been generalized to semilinear maps (i.e. `compatible_smul`)

## Tags

linear map
-/

assert_not_exists submonoid
assert_not_exists finset

open function

universes u u' v w x y z
variables {R : Type*} {R₁ : Type*} {R₂ : Type*} {R₃ : Type*}
variables {k : Type*} {S : Type*} {S₃ : Type*} {T : Type*}
variables {M : Type*} {M₁ : Type*} {M₂ : Type*} {M₃ : Type*}
variables {N₁ : Type*} {N₂ : Type*} {N₃ : Type*} {ι : Type*}

/-- A map `f` between modules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. The predicate `is_linear_map R f` asserts this
property. A bundled version is available with `linear_map`, and should be favored over
`is_linear_map` most of the time. -/
structure is_linear_map (R : Type u) {M : Type v} {M₂ : Type w}
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂]
  (f : M → M₂) : Prop :=
(map_add : ∀ x y, f (x + y) = f x + f y)
(map_smul : ∀ (c : R) x, f (c • x) = c • f x)

section

set_option old_structure_cmd true

/-- A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S`
is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and
`f (c • x) = (σ c) • f x`. Elements of `linear_map σ M M₂` (available under the notation
`M →ₛₗ[σ] M₂`) are bundled versions of such maps. For plain linear maps (i.e. for which
`σ = ring_hom.id R`), the notation `M →ₗ[R] M₂` is available. An unbundled version of plain linear
maps is available with the predicate `is_linear_map`, but it should be avoided most of the time. -/
structure linear_map {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R →+* S)
  (M : Type*) (M₂ : Type*)
  [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂]
  extends add_hom M M₂ :=
(map_smul' : ∀ (r : R) (x : M), to_fun (r • x) = (σ r) • to_fun x)

/-- The `add_hom` underlying a `linear_map`. -/
add_decl_doc linear_map.to_add_hom

notation M ` →ₛₗ[`:25 σ:25 `] `:0 M₂:0 := linear_map σ M M₂
notation M ` →ₗ[`:25 R:25 `] `:0 M₂:0 := linear_map (ring_hom.id R) M M₂
notation M ` →ₗ⋆[`:25 R:25 `] `:0 M₂:0 := linear_map (star_ring_end R) M M₂

/-- `semilinear_map_class F σ M M₂` asserts `F` is a type of bundled `σ`-semilinear maps `M → M₂`.

See also `linear_map_class F R M M₂` for the case where `σ` is the identity map on `R`.

A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S`
is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and
`f (c • x) = (σ c) • f x`. -/
class semilinear_map_class (F : Type*) {R S : out_param Type*} [semiring R] [semiring S]
  (σ : out_param $ R →+* S) (M M₂ : out_param Type*)
  [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂]
  extends add_hom_class F M M₂ :=
(map_smulₛₗ : ∀ (f : F) (r : R) (x : M), f (r • x) = (σ r) • f x)

end

-- `σ` becomes a metavariable but that's fine because it's an `out_param`
attribute [nolint dangerous_instance] semilinear_map_class.to_add_hom_class

export semilinear_map_class (map_smulₛₗ)
attribute [simp] map_smulₛₗ

/-- `linear_map_class F R M M₂` asserts `F` is a type of bundled `R`-linear maps `M → M₂`.

This is an abbreviation for `semilinear_map_class F (ring_hom.id R) M M₂`.
-/
abbreviation linear_map_class (F : Type*) (R M M₂ : out_param Type*)
  [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂] :=
semilinear_map_class F (ring_hom.id R) M M₂

namespace semilinear_map_class

variables (F : Type*)
variables [semiring R] [semiring S]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N₃]
variables [module R M] [module R M₂] [module S M₃]
variables {σ : R →+* S}

@[priority 100, nolint dangerous_instance] -- `σ` is an `out_param` so it's not dangerous
instance [semilinear_map_class F σ M M₃] : add_monoid_hom_class F M M₃ :=
{ coe := λ f, (f : M → M₃),
  map_zero := λ f, show f 0 = 0, by { rw [← zero_smul R (0 : M), map_smulₛₗ], simp },
  .. semilinear_map_class.to_add_hom_class F σ M M₃ }

@[priority 100, nolint dangerous_instance] -- `R` is an `out_param` so it's not dangerous
instance [linear_map_class F R M M₂] : distrib_mul_action_hom_class F R M M₂ :=
{ coe := λ f, (f : M → M₂),
  map_smul := λ f c x, by rw [map_smulₛₗ, ring_hom.id_apply],
  .. semilinear_map_class.add_monoid_hom_class F }

variables {F} (f : F) [i : semilinear_map_class F σ M M₃]
include i

lemma map_smul_inv {σ' : S →+* R} [ring_hom_inv_pair σ σ'] (c : S) (x : M) :
  c • f x = f (σ' c • x) :=
by simp

end semilinear_map_class

namespace linear_map

section add_comm_monoid

variables [semiring R] [semiring S]

section
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N₃]
variables [module R M] [module R M₂] [module S M₃]
variables {σ : R →+* S}

instance : semilinear_map_class (M →ₛₗ[σ] M₃) σ M M₃ :=
{ coe := linear_map.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_add := linear_map.map_add',
  map_smulₛₗ := linear_map.map_smul' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly.
-/
instance : has_coe_to_fun (M →ₛₗ[σ] M₃) (λ _, M → M₃) := ⟨λ f, f⟩

/-- The `distrib_mul_action_hom` underlying a `linear_map`. -/
def to_distrib_mul_action_hom (f : M →ₗ[R] M₂) : distrib_mul_action_hom R M M₂ :=
{ map_zero' := show f 0 = 0, from map_zero f, ..f }

@[simp] lemma to_fun_eq_coe {f : M →ₛₗ[σ] M₃} : f.to_fun = (f : M → M₃) := rfl

@[ext] theorem ext {f g : M →ₛₗ[σ] M₃} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

/-- Copy of a `linear_map` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : M →ₛₗ[σ] M₃ :=
{ to_fun := f',
  map_add' := h.symm ▸ f.map_add',
  map_smul' := h.symm ▸ f.map_smul' }

@[simp] lemma coe_copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : ⇑(f.copy f' h) = f' := rfl
lemma copy_eq (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : f.copy f' h = f := fun_like.ext' h

/-- See Note [custom simps projection]. -/
protected def simps.apply {R S : Type*} [semiring R] [semiring S] (σ : R →+* S)
  (M M₃ : Type*) [add_comm_monoid M] [add_comm_monoid M₃] [module R M] [module S M₃]
  (f : M →ₛₗ[σ] M₃) : M → M₃ := f

initialize_simps_projections linear_map (to_fun → apply)

@[simp] lemma coe_mk {σ : R →+* S} (f : M → M₃) (h₁ h₂) :
  ((linear_map.mk f h₁ h₂ : M →ₛₗ[σ] M₃) : M → M₃) = f := rfl

/-- Identity map as a `linear_map` -/
def id : M →ₗ[R] M :=
{ to_fun := id, ..distrib_mul_action_hom.id R }

lemma id_apply (x : M) :
  @id R M _ _ _ x = x := rfl

@[simp, norm_cast] lemma id_coe : ((linear_map.id : M →ₗ[R] M) : M → M) = _root_.id := rfl

end

section
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N₃]
variables [module R M] [module R M₂] [module S M₃]
variables (σ : R →+* S)
variables (fₗ gₗ : M →ₗ[R] M₂) (f g : M →ₛₗ[σ] M₃)

theorem is_linear : is_linear_map R fₗ := ⟨fₗ.map_add', fₗ.map_smul'⟩

variables {fₗ gₗ f g σ}

theorem coe_injective : @injective (M →ₛₗ[σ] M₃) (M → M₃) coe_fn :=
fun_like.coe_injective

protected lemma congr_arg {x x' : M} : x = x' → f x = f x' :=
fun_like.congr_arg f

/-- If two linear maps are equal, they are equal at each point. -/
protected lemma congr_fun (h : f = g) (x : M) : f x = g x :=
fun_like.congr_fun h x

theorem ext_iff : f = g ↔ ∀ x, f x = g x :=
fun_like.ext_iff

@[simp] lemma mk_coe (f : M →ₛₗ[σ] M₃) (h₁ h₂) :
  (linear_map.mk f h₁ h₂ : M →ₛₗ[σ] M₃) = f := ext $ λ _, rfl

variables (fₗ gₗ f g)

protected lemma map_add (x y : M) : f (x + y) = f x + f y := map_add f x y
protected lemma map_zero : f 0 = 0 := map_zero f
-- TODO: `simp` isn't picking up `map_smulₛₗ` for `linear_map`s without specifying `map_smulₛₗ f`
@[simp] protected lemma map_smulₛₗ (c : R) (x : M) : f (c • x) = (σ c) • f x := map_smulₛₗ f c x
protected lemma map_smul (c : R) (x : M) : fₗ (c • x) = c • fₗ x := map_smul fₗ c x
protected lemma map_smul_inv {σ' : S →+* R} [ring_hom_inv_pair σ σ'] (c : S) (x : M) :
  c • f x = f (σ' c • x) :=
by simp

-- TODO: generalize to `zero_hom_class`
@[simp] lemma map_eq_zero_iff (h : function.injective f) {x : M} : f x = 0 ↔ x = 0 :=
⟨λ w, by { apply h, simp [w], }, λ w, by { subst w, simp, }⟩

section pointwise
open_locale pointwise

variables (M M₃ σ) {F : Type*} (h : F)

@[simp] lemma _root_.image_smul_setₛₗ [semilinear_map_class F σ M M₃] (c : R) (s : set M) :
  h '' (c • s) = (σ c) • h '' s :=
begin
  apply set.subset.antisymm,
  { rintros x ⟨y, ⟨z, zs, rfl⟩, rfl⟩,
    exact ⟨h z, set.mem_image_of_mem _ zs, (map_smulₛₗ _ _ _).symm ⟩ },
  { rintros x ⟨y, ⟨z, hz, rfl⟩, rfl⟩,
    exact (set.mem_image _ _ _).2 ⟨c • z, set.smul_mem_smul_set hz, map_smulₛₗ _ _ _⟩ }
end

lemma _root_.preimage_smul_setₛₗ [semilinear_map_class F σ M M₃] {c : R} (hc : is_unit c)
  (s : set M₃) : h ⁻¹' (σ c • s) = c • h ⁻¹' s :=
begin
  apply set.subset.antisymm,
  { rintros x ⟨y, ys, hy⟩,
    refine ⟨(hc.unit.inv : R) • x, _, _⟩,
    { simp only [←hy, smul_smul, set.mem_preimage, units.inv_eq_coe_inv, map_smulₛₗ h, ← map_mul,
        is_unit.coe_inv_mul, one_smul, map_one, ys] },
    { simp only [smul_smul, is_unit.mul_coe_inv, one_smul, units.inv_eq_coe_inv] } },
  { rintros x ⟨y, hy, rfl⟩,
    refine ⟨h y, hy, by simp only [ring_hom.id_apply, map_smulₛₗ h]⟩ }
end

variables (R M₂)

lemma _root_.image_smul_set [linear_map_class F R M M₂] (c : R) (s : set M) :
  h '' (c • s) = c • h '' s :=
image_smul_setₛₗ _ _ _ h c s

lemma _root_.preimage_smul_set [linear_map_class F R M M₂] {c : R} (hc : is_unit c) (s : set M₂) :
  h ⁻¹' (c • s) = c • h ⁻¹' s :=
preimage_smul_setₛₗ _ _ _ h hc s

end pointwise

variables (M M₂)
/--
A typeclass for `has_smul` structures which can be moved through a `linear_map`.
This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that
we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if
`R` does not support negation.
-/
class compatible_smul (R S : Type*) [semiring S] [has_smul R M]
  [module S M] [has_smul R M₂] [module S M₂] :=
(map_smul : ∀ (fₗ : M →ₗ[S] M₂) (c : R) (x : M), fₗ (c • x) = c • fₗ x)
variables {M M₂}

@[priority 100]
instance is_scalar_tower.compatible_smul
  {R S : Type*} [semiring S] [has_smul R S]
  [has_smul R M] [module S M] [is_scalar_tower R S M]
  [has_smul R M₂] [module S M₂] [is_scalar_tower R S M₂] : compatible_smul M M₂ R S :=
⟨λ fₗ c x, by rw [← smul_one_smul S c x, ← smul_one_smul S c (fₗ x), map_smul]⟩

@[simp, priority 900]
lemma map_smul_of_tower {R S : Type*} [semiring S] [has_smul R M]
  [module S M] [has_smul R M₂] [module S M₂]
  [compatible_smul M M₂ R S] (fₗ : M →ₗ[S] M₂) (c : R) (x : M) :
  fₗ (c • x) = c • fₗ x :=
compatible_smul.map_smul fₗ c x

/-- convert a linear map to an additive map -/
def to_add_monoid_hom : M →+ M₃ :=
{ to_fun := f,
  map_zero' := f.map_zero,
  map_add' := f.map_add }

@[simp] lemma to_add_monoid_hom_coe : ⇑f.to_add_monoid_hom = f := rfl

section restrict_scalars

variables (R) [module S M] [module S M₂] [compatible_smul M M₂ R S]

/-- If `M` and `M₂` are both `R`-modules and `S`-modules and `R`-module structures
are defined by an action of `R` on `S` (formally, we have two scalar towers), then any `S`-linear
map from `M` to `M₂` is `R`-linear.

See also `linear_map.map_smul_of_tower`. -/
def restrict_scalars (fₗ : M →ₗ[S] M₂) : M →ₗ[R] M₂ :=
{ to_fun := fₗ,
  map_add' := fₗ.map_add,
  map_smul' := fₗ.map_smul_of_tower }

@[simp] lemma coe_restrict_scalars (fₗ : M →ₗ[S] M₂) : ⇑(restrict_scalars R fₗ) = fₗ :=
rfl

lemma restrict_scalars_apply (fₗ : M →ₗ[S] M₂) (x) : restrict_scalars R fₗ x = fₗ x :=
rfl

lemma restrict_scalars_injective :
  function.injective (restrict_scalars R : (M →ₗ[S] M₂) → (M →ₗ[R] M₂)) :=
λ fₗ gₗ h, ext (linear_map.congr_fun h : _)

@[simp]
lemma restrict_scalars_inj (fₗ gₗ : M →ₗ[S] M₂) :
  fₗ.restrict_scalars R = gₗ.restrict_scalars R ↔ fₗ = gₗ :=
(restrict_scalars_injective R).eq_iff

end restrict_scalars

variable {R}

theorem to_add_monoid_hom_injective :
  function.injective (to_add_monoid_hom : (M →ₛₗ[σ] M₃) → (M →+ M₃)) :=
λ f g h, ext $ add_monoid_hom.congr_fun h

/-- If two `σ`-linear maps from `R` are equal on `1`, then they are equal. -/
@[ext] theorem ext_ring {f g : R →ₛₗ[σ] M₃} (h : f 1 = g 1) : f = g :=
ext $ λ x, by rw [← mul_one x, ← smul_eq_mul, f.map_smulₛₗ, g.map_smulₛₗ, h]

theorem ext_ring_iff {σ : R →+* R} {f g : R →ₛₗ[σ] M} : f = g ↔ f 1 = g 1 :=
⟨λ h, h ▸ rfl, ext_ring⟩

@[ext] theorem ext_ring_op {σ : Rᵐᵒᵖ →+* S} {f g : R →ₛₗ[σ] M₃} (h : f 1 = g 1) : f = g :=
ext $ λ x, by rw [← one_mul x, ← op_smul_eq_mul, f.map_smulₛₗ, g.map_smulₛₗ, h]

end

/-- Interpret a `ring_hom` `f` as an `f`-semilinear map. -/
@[simps]
def _root_.ring_hom.to_semilinear_map (f : R →+* S) : R →ₛₗ[f] S :=
{ to_fun := f,
  map_smul' := f.map_mul,
  .. f}

section

variables [semiring R₁] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables {module_M₁ : module R₁ M₁} {module_M₂ : module R₂ M₂} {module_M₃ : module R₃ M₃}
variables {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃}
variables [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃]
variables (f : M₂ →ₛₗ[σ₂₃] M₃) (g : M₁ →ₛₗ[σ₁₂] M₂)

include module_M₁ module_M₂ module_M₃
/-- Composition of two linear maps is a linear map -/
def comp : M₁ →ₛₗ[σ₁₃] M₃ :=
{ to_fun := f ∘ g,
  map_add' := by simp only [map_add, forall_const, eq_self_iff_true, comp_app],
  map_smul' := λ r x, by rw [comp_app, map_smulₛₗ, map_smulₛₗ, ring_hom_comp_triple.comp_apply] }
omit module_M₁ module_M₂ module_M₃

infixr ` ∘ₗ `:80 := @linear_map.comp _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
  (ring_hom.id _) (ring_hom.id _) (ring_hom.id _) ring_hom_comp_triple.ids

include σ₁₃
lemma comp_apply (x : M₁) : f.comp g x = f (g x) := rfl
omit σ₁₃

include σ₁₃
@[simp, norm_cast] lemma coe_comp : (f.comp g : M₁ → M₃) = f ∘ g := rfl
omit σ₁₃

@[simp] theorem comp_id : f.comp id = f :=
linear_map.ext $ λ x, rfl

@[simp] theorem id_comp : id.comp f = f :=
linear_map.ext $ λ x, rfl

variables {f g} {f' : M₂ →ₛₗ[σ₂₃] M₃} {g' : M₁ →ₛₗ[σ₁₂] M₂}

include σ₁₃
theorem cancel_right (hg : function.surjective g) :
  f.comp g = f'.comp g ↔ f = f' :=
⟨λ h, ext $ hg.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩

theorem cancel_left (hf : function.injective f) :
  f.comp g = f.comp g' ↔ g = g' :=
⟨λ h, ext $ λ x, hf $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩
omit σ₁₃

end

variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]

/-- If a function `g` is a left and right inverse of a linear map `f`, then `g` is linear itself. -/
def inverse [module R M] [module S M₂] {σ : R →+* S} {σ' : S →+* R} [ring_hom_inv_pair σ σ']
  (f : M →ₛₗ[σ] M₂) (g : M₂ → M) (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
  M₂ →ₛₗ[σ'] M :=
by dsimp [left_inverse, function.right_inverse] at h₁ h₂; exact
  { to_fun := g,
    map_add' := λ x y, by { rw [← h₁ (g (x + y)), ← h₁ (g x + g y)]; simp [h₂] },
    map_smul' := λ a b, by { rw [← h₁ (g (a • b)), ← h₁ ((σ' a) • g b)], simp [h₂] } }

end add_comm_monoid

section add_comm_group

variables [semiring R] [semiring S] [add_comm_group M] [add_comm_group M₂]
variables {module_M : module R M} {module_M₂ : module S M₂} {σ : R →+* S}
variables (f : M →ₛₗ[σ] M₂)

protected lemma map_neg (x : M) : f (- x) = - f x := map_neg f x

protected lemma map_sub (x y : M) : f (x - y) = f x - f y := map_sub f x y

instance compatible_smul.int_module
  {S : Type*} [semiring S] [module S M] [module S M₂] : compatible_smul M M₂ ℤ S :=
⟨λ fₗ c x, begin
  induction c using int.induction_on,
  case hz : { simp },
  case hp : n ih { simp [add_smul, ih] },
  case hn : n ih { simp [sub_smul, ih] }
end⟩

instance compatible_smul.units {R S : Type*}
  [monoid R] [mul_action R M] [mul_action R M₂] [semiring S] [module S M] [module S M₂]
  [compatible_smul M M₂ R S] :
  compatible_smul M M₂ Rˣ S :=
⟨λ fₗ c x, (compatible_smul.map_smul fₗ (c : R) x : _)⟩

end add_comm_group

end linear_map

namespace module

/-- `g : R →+* S` is `R`-linear when the module structure on `S` is `module.comp_hom S g` . -/
@[simps]
def comp_hom.to_linear_map {R S : Type*} [semiring R] [semiring S] (g : R →+* S) :
  (by haveI := comp_hom S g; exact (R →ₗ[R] S)) :=
by exact
{ to_fun := (g : R → S),
  map_add' := g.map_add,
  map_smul' := g.map_mul }

end module

namespace distrib_mul_action_hom

variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂]

/-- A `distrib_mul_action_hom` between two modules is a linear map. -/
def to_linear_map (fₗ : M →+[R] M₂) : M →ₗ[R] M₂ := { ..fₗ }

instance : has_coe (M →+[R] M₂) (M →ₗ[R] M₂) := ⟨to_linear_map⟩

@[simp] lemma to_linear_map_eq_coe (f : M →+[R] M₂) :
  f.to_linear_map = ↑f :=
rfl

@[simp, norm_cast] lemma coe_to_linear_map (f : M →+[R] M₂) :
  ((f : M →ₗ[R] M₂) : M → M₂) = f :=
rfl

lemma to_linear_map_injective {f g : M →+[R] M₂} (h : (f : M →ₗ[R] M₂) = (g : M →ₗ[R] M₂)) :
  f = g :=
by { ext m, exact linear_map.congr_fun h m, }

end distrib_mul_action_hom

namespace is_linear_map

section add_comm_monoid
variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂]
variables [module R M] [module R M₂]
include R

/-- Convert an `is_linear_map` predicate to a `linear_map` -/
def mk' (f : M → M₂) (H : is_linear_map R f) : M →ₗ[R] M₂ :=
{ to_fun := f, map_add' := H.1, map_smul' := H.2 }

@[simp] theorem mk'_apply {f : M → M₂} (H : is_linear_map R f) (x : M) :
  mk' f H x = f x := rfl

lemma is_linear_map_smul {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
  (c : R) :
  is_linear_map R (λ (z : M), c • z) :=
begin
  refine is_linear_map.mk (smul_add c) _,
  intros _ _,
  simp only [smul_smul, mul_comm]
end

lemma is_linear_map_smul' {R M : Type*} [semiring R] [add_comm_monoid M] [module R M] (a : M) :
  is_linear_map R (λ (c : R), c • a) :=
is_linear_map.mk (λ x y, add_smul x y a) (λ x y, mul_smul x y a)

variables {f : M → M₂} (lin : is_linear_map R f)
include M M₂ lin

lemma map_zero : f (0 : M) = (0 : M₂) := (lin.mk' f).map_zero

end add_comm_monoid

section add_comm_group

variables [semiring R] [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R M₂]
include R

lemma is_linear_map_neg :
  is_linear_map R (λ (z : M), -z) :=
is_linear_map.mk neg_add (λ x y, (smul_neg x y).symm)

variables {f : M → M₂} (lin : is_linear_map R f)
include M M₂ lin

lemma map_neg (x : M) : f (- x) = - f x := (lin.mk' f).map_neg x

lemma map_sub (x y) : f (x - y) = f x - f y := (lin.mk' f).map_sub x y

end add_comm_group

end is_linear_map

/-- Linear endomorphisms of a module, with associated ring structure
`module.End.semiring` and algebra structure `module.End.algebra`. -/
abbreviation module.End (R : Type u) (M : Type v)
  [semiring R] [add_comm_monoid M] [module R M] := M →ₗ[R] M

/-- Reinterpret an additive homomorphism as a `ℕ`-linear map. -/
def add_monoid_hom.to_nat_linear_map [add_comm_monoid M] [add_comm_monoid M₂] (f : M →+ M₂) :
  M →ₗ[ℕ] M₂ :=
{ to_fun := f, map_add' := f.map_add, map_smul' := map_nsmul f }

lemma add_monoid_hom.to_nat_linear_map_injective [add_comm_monoid M] [add_comm_monoid M₂] :
  function.injective (@add_monoid_hom.to_nat_linear_map M M₂ _ _) :=
by { intros f g h, ext, exact linear_map.congr_fun h x }

/-- Reinterpret an additive homomorphism as a `ℤ`-linear map. -/
def add_monoid_hom.to_int_linear_map [add_comm_group M] [add_comm_group M₂] (f : M →+ M₂) :
  M →ₗ[ℤ] M₂ :=
{ to_fun := f, map_add' := f.map_add, map_smul' := map_zsmul f }

lemma add_monoid_hom.to_int_linear_map_injective [add_comm_group M] [add_comm_group M₂] :
  function.injective (@add_monoid_hom.to_int_linear_map M M₂ _ _) :=
by { intros f g h, ext, exact linear_map.congr_fun h x }

@[simp] lemma add_monoid_hom.coe_to_int_linear_map [add_comm_group M] [add_comm_group M₂]
  (f : M →+ M₂) :
  ⇑f.to_int_linear_map = f := rfl

/-- Reinterpret an additive homomorphism as a `ℚ`-linear map. -/
def add_monoid_hom.to_rat_linear_map [add_comm_group M] [module ℚ M]
  [add_comm_group M₂] [module ℚ M₂] (f : M →+ M₂) :
  M →ₗ[ℚ] M₂ :=
{ map_smul' := map_rat_smul f, ..f }

lemma add_monoid_hom.to_rat_linear_map_injective
  [add_comm_group M] [module ℚ M] [add_comm_group M₂] [module ℚ M₂] :
  function.injective (@add_monoid_hom.to_rat_linear_map M M₂ _ _ _ _) :=
by { intros f g h, ext, exact linear_map.congr_fun h x }

@[simp] lemma add_monoid_hom.coe_to_rat_linear_map [add_comm_group M] [module ℚ M]
  [add_comm_group M₂] [module ℚ M₂] (f : M →+ M₂) :
  ⇑f.to_rat_linear_map = f := rfl

namespace linear_map

section has_smul

variables [semiring R] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [module R M] [module R₂ M₂] [module R₃ M₃]
variables {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃]
variables [monoid S] [distrib_mul_action S M₂] [smul_comm_class R₂ S M₂]
variables [monoid S₃] [distrib_mul_action S₃ M₃] [smul_comm_class R₃ S₃ M₃]
variables [monoid T] [distrib_mul_action T M₂] [smul_comm_class R₂ T M₂]

instance : has_smul S (M →ₛₗ[σ₁₂] M₂) :=
⟨λ a f, { to_fun := a • f,
          map_add' := λ x y, by simp only [pi.smul_apply, f.map_add, smul_add],
          map_smul' := λ c x, by simp [pi.smul_apply, smul_comm (σ₁₂ c)] }⟩

@[simp] lemma smul_apply (a : S) (f : M →ₛₗ[σ₁₂] M₂) (x : M) : (a • f) x = a • f x := rfl

lemma coe_smul (a : S) (f : M →ₛₗ[σ₁₂] M₂) : ⇑(a • f) = a • f := rfl

instance [smul_comm_class S T M₂] : smul_comm_class S T (M →ₛₗ[σ₁₂] M₂) :=
⟨λ a b f, ext $ λ x, smul_comm _ _ _⟩

-- example application of this instance: if S -> T -> R are homomorphisms of commutative rings and
-- M and M₂ are R-modules then the S-module and T-module structures on Hom_R(M,M₂) are compatible.
instance [has_smul S T] [is_scalar_tower S T M₂] : is_scalar_tower S T (M →ₛₗ[σ₁₂] M₂) :=
{ smul_assoc := λ _ _ _, ext $ λ _, smul_assoc _ _ _ }

instance [distrib_mul_action Sᵐᵒᵖ M₂] [smul_comm_class R₂ Sᵐᵒᵖ M₂] [is_central_scalar S M₂] :
  is_central_scalar S (M →ₛₗ[σ₁₂] M₂) :=
{ op_smul_eq_smul := λ a b, ext $ λ x, op_smul_eq_smul _ _ }

end has_smul

/-! ### Arithmetic on the codomain -/
section arithmetic

variables [semiring R₁] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [add_comm_group N₁] [add_comm_group N₂] [add_comm_group N₃]
variables [module R₁ M] [module R₂ M₂] [module R₃ M₃]
variables [module R₁ N₁] [module R₂ N₂] [module R₃ N₃]
variables {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃]

/-- The constant 0 map is linear. -/
instance : has_zero (M →ₛₗ[σ₁₂] M₂) :=
⟨{ to_fun := 0, map_add' := by simp, map_smul' := by simp }⟩

@[simp] lemma zero_apply (x : M) : (0 : M →ₛₗ[σ₁₂] M₂) x = 0 := rfl

@[simp] theorem comp_zero (g : M₂ →ₛₗ[σ₂₃] M₃) : (g.comp (0 : M →ₛₗ[σ₁₂] M₂) : M →ₛₗ[σ₁₃] M₃) = 0 :=
ext $ assume c, by rw [comp_apply, zero_apply, zero_apply, g.map_zero]

@[simp] theorem zero_comp (f : M →ₛₗ[σ₁₂] M₂) : ((0 : M₂ →ₛₗ[σ₂₃] M₃).comp f : M →ₛₗ[σ₁₃] M₃) = 0 :=
rfl

instance : inhabited (M →ₛₗ[σ₁₂] M₂) := ⟨0⟩

@[simp] lemma default_def : (default : (M →ₛₗ[σ₁₂] M₂)) = 0 := rfl

/-- The sum of two linear maps is linear. -/
instance : has_add (M →ₛₗ[σ₁₂] M₂) :=
⟨λ f g, { to_fun := f + g,
          map_add' := by simp [add_comm, add_left_comm],
          map_smul' := by simp [smul_add] }⟩

@[simp] lemma add_apply (f g : M →ₛₗ[σ₁₂] M₂) (x : M) : (f + g) x = f x + g x := rfl

lemma add_comp (f : M →ₛₗ[σ₁₂] M₂) (g h : M₂ →ₛₗ[σ₂₃] M₃) :
  ((h + g).comp f : M →ₛₗ[σ₁₃] M₃) = h.comp f + g.comp f := rfl

lemma comp_add (f g : M →ₛₗ[σ₁₂] M₂) (h : M₂ →ₛₗ[σ₂₃] M₃) :
  (h.comp (f + g) : M →ₛₗ[σ₁₃] M₃) = h.comp f + h.comp g :=
ext $ λ _, h.map_add _ _

/-- The type of linear maps is an additive monoid. -/
instance : add_comm_monoid (M →ₛₗ[σ₁₂] M₂) :=
fun_like.coe_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)

/-- The negation of a linear map is linear. -/
instance : has_neg (M →ₛₗ[σ₁₂] N₂) :=
⟨λ f, { to_fun := -f, map_add' := by simp [add_comm], map_smul' := by simp }⟩

@[simp] lemma neg_apply (f : M →ₛₗ[σ₁₂] N₂) (x : M) : (- f) x = - f x := rfl

include σ₁₃
@[simp] lemma neg_comp (f : M →ₛₗ[σ₁₂] M₂) (g : M₂ →ₛₗ[σ₂₃] N₃) : (- g).comp f = - g.comp f := rfl

@[simp] lemma comp_neg (f : M →ₛₗ[σ₁₂] N₂) (g : N₂ →ₛₗ[σ₂₃] N₃) : g.comp (- f) = - g.comp f :=
ext $ λ _, g.map_neg _
omit σ₁₃

/-- The subtraction of two linear maps is linear. -/
instance : has_sub (M →ₛₗ[σ₁₂] N₂) :=
⟨λ f g, { to_fun := f - g,
          map_add' := λ x y, by simp only [pi.sub_apply, map_add, add_sub_add_comm],
          map_smul' := λ r x, by simp [pi.sub_apply, map_smul, smul_sub] }⟩

@[simp] lemma sub_apply (f g : M →ₛₗ[σ₁₂] N₂) (x : M) : (f - g) x = f x - g x := rfl

include σ₁₃
lemma sub_comp (f : M →ₛₗ[σ₁₂] M₂) (g h : M₂ →ₛₗ[σ₂₃] N₃) :
  (g - h).comp f = g.comp f - h.comp f := rfl

lemma comp_sub (f g : M →ₛₗ[σ₁₂] N₂) (h : N₂ →ₛₗ[σ₂₃] N₃) :
  h.comp (g - f) = h.comp g - h.comp f :=
ext $ λ _, h.map_sub _ _
omit σ₁₃

/-- The type of linear maps is an additive group. -/
instance : add_comm_group (M →ₛₗ[σ₁₂] N₂) :=
fun_like.coe_injective.add_comm_group _
  rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)  (λ _ _, rfl)

end arithmetic

section actions

variables [semiring R] [semiring R₂] [semiring R₃]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃]
variables [module R M] [module R₂ M₂] [module R₃ M₃]
variables {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃]

section has_smul
variables [monoid S] [distrib_mul_action S M₂] [smul_comm_class R₂ S M₂]
variables [monoid S₃] [distrib_mul_action S₃ M₃] [smul_comm_class R₃ S₃ M₃]
variables [monoid T] [distrib_mul_action T M₂] [smul_comm_class R₂ T M₂]

instance : distrib_mul_action S (M →ₛₗ[σ₁₂] M₂) :=
{ one_smul := λ f, ext $ λ _, one_smul _ _,
  mul_smul := λ c c' f, ext $ λ _, mul_smul _ _ _,
  smul_add := λ c f g, ext $ λ x, smul_add _ _ _,
  smul_zero := λ c, ext $ λ x, smul_zero _ }

include σ₁₃
theorem smul_comp (a : S₃) (g : M₂ →ₛₗ[σ₂₃] M₃) (f : M →ₛₗ[σ₁₂] M₂) :
  (a • g).comp f = a • (g.comp f) := rfl
omit σ₁₃

-- TODO: generalize this to semilinear maps
theorem comp_smul [module R M₂] [module R M₃] [smul_comm_class R S M₂] [distrib_mul_action S M₃]
  [smul_comm_class R S M₃] [compatible_smul M₃ M₂ S R]
  (g : M₃ →ₗ[R] M₂) (a : S) (f : M →ₗ[R] M₃) : g.comp (a • f) = a • (g.comp f) :=
ext $ λ x, g.map_smul_of_tower _ _

end has_smul

section module
variables [semiring S] [module S M₂] [smul_comm_class R₂ S M₂]

instance : module S (M →ₛₗ[σ₁₂] M₂) :=
{ add_smul := λ a b f, ext $ λ x, add_smul _ _ _,
  zero_smul := λ f, ext $ λ x, zero_smul _ _ }

instance [no_zero_smul_divisors S M₂] : no_zero_smul_divisors S (M →ₛₗ[σ₁₂] M₂) :=
coe_injective.no_zero_smul_divisors _ rfl coe_smul

end module

end actions

/-!
### Monoid structure of endomorphisms

Lemmas about `pow` such as `linear_map.pow_apply` appear in later files.
-/
section endomorphisms

variables [semiring R] [add_comm_monoid M] [add_comm_group N₁] [module R M] [module R N₁]

instance : has_one (module.End R M) := ⟨linear_map.id⟩
instance : has_mul (module.End R M) := ⟨linear_map.comp⟩

lemma one_eq_id : (1 : module.End R M) = id := rfl
lemma mul_eq_comp (f g : module.End R M) : f * g = f.comp g := rfl

@[simp] lemma one_apply (x : M) : (1 : module.End R M) x = x := rfl
@[simp] lemma mul_apply (f g : module.End R M) (x : M) : (f * g) x = f (g x) := rfl

lemma coe_one : ⇑(1 : module.End R M) = _root_.id := rfl
lemma coe_mul (f g : module.End R M) : ⇑(f * g) = f ∘ g := rfl

instance _root_.module.End.monoid : monoid (module.End R M) :=
{ mul := (*),
  one := (1 : M →ₗ[R] M),
  mul_assoc := λ f g h, linear_map.ext $ λ x, rfl,
  mul_one := comp_id,
  one_mul := id_comp }

instance _root_.module.End.semiring : semiring (module.End R M) :=
{ mul := (*),
  one := (1 : M →ₗ[R] M),
  zero := 0,
  add := (+),
  mul_zero := comp_zero,
  zero_mul := zero_comp,
  left_distrib := λ f g h, comp_add _ _ _,
  right_distrib := λ f g h, add_comp _ _ _,
  nat_cast := λ n, n • 1,
  nat_cast_zero := add_monoid.nsmul_zero' _,
  nat_cast_succ := λ n, (add_monoid.nsmul_succ' n 1).trans (add_comm _ _),
  .. add_monoid_with_one.unary,
  .. _root_.module.End.monoid,
  .. linear_map.add_comm_monoid }

/-- See also `module.End.nat_cast_def`. -/
@[simp] lemma _root_.module.End.nat_cast_apply (n : ℕ) (m : M) :
  (↑n : module.End R M) m = n • m := rfl

instance _root_.module.End.ring : ring (module.End R N₁) :=
{ int_cast := λ z, z • 1,
  int_cast_of_nat := of_nat_zsmul _,
  int_cast_neg_succ_of_nat := zsmul_neg_succ_of_nat _,
  ..module.End.semiring, ..linear_map.add_comm_group }

/-- See also `module.End.int_cast_def`. -/
@[simp] lemma _root_.module.End.int_cast_apply (z : ℤ) (m : N₁) :
  (↑z : module.End R N₁) m = z • m := rfl

section
variables [monoid S] [distrib_mul_action S M] [smul_comm_class R S M]

instance _root_.module.End.is_scalar_tower :
  is_scalar_tower S (module.End R M) (module.End R M) := ⟨smul_comp⟩

instance _root_.module.End.smul_comm_class [has_smul S R] [is_scalar_tower S R M] :
  smul_comm_class S (module.End R M) (module.End R M) :=
⟨λ s _ _, (comp_smul _ s _).symm⟩

instance _root_.module.End.smul_comm_class' [has_smul S R] [is_scalar_tower S R M] :
  smul_comm_class (module.End R M) S (module.End R M) :=
smul_comm_class.symm _ _ _

end

/-! ### Action by a module endomorphism. -/

/-- The tautological action by `module.End R M` (aka `M →ₗ[R] M`) on `M`.

This generalizes `function.End.apply_mul_action`. -/
instance apply_module : module (module.End R M) M :=
{ smul := ($),
  smul_zero := linear_map.map_zero,
  smul_add := linear_map.map_add,
  add_smul := linear_map.add_apply,
  zero_smul := (linear_map.zero_apply : ∀ m, (0 : M →ₗ[R] M) m = 0),
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] protected lemma smul_def (f : module.End R M) (a : M) : f • a = f a := rfl

/-- `linear_map.apply_module` is faithful. -/
instance apply_has_faithful_smul : has_faithful_smul (module.End R M) M :=
⟨λ _ _, linear_map.ext⟩

instance apply_smul_comm_class : smul_comm_class R (module.End R M) M :=
{ smul_comm := λ r e m, (e.map_smul r m).symm }

instance apply_smul_comm_class' : smul_comm_class (module.End R M) R M :=
{ smul_comm := linear_map.map_smul }

instance apply_is_scalar_tower {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M] :
  is_scalar_tower R (module.End R M) M :=
⟨λ t f m, rfl⟩

end endomorphisms

end linear_map

/-! ### Actions as module endomorphisms -/

namespace distrib_mul_action

variables (R M) [semiring R] [add_comm_monoid M] [module R M]
variables [monoid S] [distrib_mul_action S M] [smul_comm_class S R M]

/-- Each element of the monoid defines a linear map.

This is a stronger version of `distrib_mul_action.to_add_monoid_hom`. -/
@[simps]
def to_linear_map (s : S) : M →ₗ[R] M :=
{ to_fun := has_smul.smul s,
  map_add' := smul_add s,
  map_smul' := λ a b, smul_comm _ _ _ }

/-- Each element of the monoid defines a module endomorphism.

This is a stronger version of `distrib_mul_action.to_add_monoid_End`. -/
@[simps]
def to_module_End : S →* module.End R M :=
{ to_fun := to_linear_map R M,
  map_one' := linear_map.ext $ one_smul _,
  map_mul' := λ a b, linear_map.ext $ mul_smul _ _ }

end distrib_mul_action

namespace module

variables (R M) [semiring R] [add_comm_monoid M] [module R M]
variables [semiring S] [module S M] [smul_comm_class S R M]

/-- Each element of the semiring defines a module endomorphism.

This is a stronger version of `distrib_mul_action.to_module_End`. -/
@[simps]
def to_module_End : S →+* module.End R M :=
{ to_fun := distrib_mul_action.to_linear_map R M,
  map_zero' := linear_map.ext $ zero_smul _,
  map_add' := λ f g, linear_map.ext $ add_smul _ _,
  ..distrib_mul_action.to_module_End R M }

/-- The canonical (semi)ring isomorphism from `Rᵐᵒᵖ` to `module.End R R` induced by the right
multiplication. -/
@[simps]
def module_End_self : Rᵐᵒᵖ ≃+* module.End R R :=
{ to_fun := distrib_mul_action.to_linear_map R R,
  inv_fun := λ f, mul_opposite.op (f 1),
  left_inv := mul_one,
  right_inv := λ f, linear_map.ext_ring $ one_mul _,
  ..module.to_module_End R R }

/-- The canonical (semi)ring isomorphism from `R` to `module.End Rᵐᵒᵖ R` induced by the left
multiplication. -/
@[simps]
def module_End_self_op : R ≃+* module.End Rᵐᵒᵖ R :=
{ to_fun := distrib_mul_action.to_linear_map _ _,
  inv_fun := λ f, f 1,
  left_inv := mul_one,
  right_inv := λ f, linear_map.ext_ring_op $ mul_one _,
  ..module.to_module_End _ _ }

lemma End.nat_cast_def (n : ℕ) [add_comm_monoid N₁] [module R N₁] :
  (↑n : module.End R N₁) = module.to_module_End R N₁ n := rfl

lemma End.int_cast_def (z : ℤ) [add_comm_group N₁] [module R N₁] :
  (↑z : module.End R N₁) = module.to_module_End R N₁ z := rfl

end module


import ring_theory.ideal.basic

variables {R S : Type} [comm_ring R] [comm_ring S] (I : ideal R)

/- ### Intro
Voici une liste d'examples à faire une fois que vous aurez terminé le premier chapitre
de Atiyah-Macdonald -/

example (a b : R) : a ∈ I → b ∈ I → (a + b) ∈ I :=
begin
  intros ha hb,
  exact I.add_mem ha hb,
end

example (a x : R) : a ∈ I → (a * x) ∈ I ∧ (x * a) ∈ I :=
begin
  intro ha,
  split,
  rewrite mul_comm,
  all_goals {
    apply I.smul_mem,
    assumption},
end

/- Est-ce que vous pouvez expliquer pourquoi l'énoncé "la préimage d'un idéal par un morphisme
d'anneaux" est une `définition` et pas un `lemme`? -/
definition preimage (f : R →+* S) (J : ideal S) : (ideal R) :=
/- "_" va afficher une ampoule et me permet de générer le squelette nécessaire pour consrtuire le terme
avce begin end, on peut utiliser "fconstructor" pour split le goal dans un ordre "logique"-/
{ carrier := {x : R | f x ∈ J},
  add_mem' :=
  begin
    simp,
    intros a b hfa hfb,
    apply J.add_mem hfa hfb,
  end,

  zero_mem' :=
  begin
    simp only [set.mem_set_of_eq, map_zero, submodule.zero_mem],
  end,

  smul_mem' :=
  begin
    intros x r hfr,
    simp only [smul_eq_mul, set.mem_set_of_eq, map_mul],
    apply J.smul_mem,
    apply hfr,
  end
   }

example (f : R →+* S) (J : ideal S) (hJ: J.is_prime) : (preimage f J).is_prime :=
begin
    -- let h1 := hJ.1, /-différence entre have and let ?-/
    -- fconstructor,
    -- rw ideal.ne_top_iff_one,
    -- have : (f 1) ∉ J,
    -- rw map_one,
    -- apply (ideal.ne_top_iff_one J).mp h1,
    -- exact this,

  let h1 := hJ.1, /-différence entre have et let ?-/
  fconstructor,
  by_contradiction,
  apply h1,
  rw J.eq_top_iff_one,
  rw ← f.map_one,
  convert_to (1 : R) ∈ preimage f J,
  rw ← ideal.eq_top_iff_one,
  exact h,

  --   have : (1:R) ∈ preimage f J,
  --     rw ← ideal.eq_top_iff_one,
  --     exact h,
  -- exact this,

  -- apply (preimage f J).carrier,

  intros x y hxy,
  convert_to (f x ∈ J) ∨ (f y ∈ J),
  apply hJ.mem_or_mem',
  rw ← map_mul,
  exact hxy,

end,

/- Est-ce que vous pouvez expliquer pourquoi l'énoncé "l'intersection de deux idéaux est un idéal" est
une `définition` et pas un `lemme`? -/
definition intersection (J : ideal R) : ideal R :=
{ carrier := I ∩ J,
  add_mem' :=
  begin
    intros a b ha hb,
    cases ha with hai haj,
    cases hb with hbi hbj,
    split,
    apply I.add_mem,
    exact hai,
    exact hbi,
    apply J.add_mem,
    exact haj,
    exact hbj,
  end,

  zero_mem' :=
  begin
    split,
    exact I.zero_mem',
    exact J.zero_mem',
  end,

  smul_mem' :=
  begin
    intros c x hx,
    cases hx with hxi hxj,
    split,
    apply I.smul_mem',
    exact hxi,
    apply J.smul_mem',
    exact hxj,
  end }

-- Pourquoi l'exemple suivant ne compile pas, même avec la définition précédente?
example (J : ideal R) (x y : R) : x ∈ I → x ∈ J → x ∈ intersection J I :=
begin
  intros hI hJ,
  split,
  exact hJ,
  exact hI,
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Julian Kuelshammer, Heather Macbeth
-/
import data.polynomial.derivative
import tactic.ring

/-!
# Chebyshev polynomials

The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
with integral coefficients.

## Main definitions

* `polynomial.chebyshev.T`: the Chebyshev polynomials of the first kind.
* `polynomial.chebyshev.U`: the Chebyshev polynomials of the second kind.

## Main statements

* The formal derivative of the Chebyshev polynomials of the first kind is a scalar multiple of the
  Chebyshev polynomials of the second kind.
* `polynomial.chebyshev.mul_T`, the product of the `m`-th and `(m + k)`-th Chebyshev polynomials of
  the first kind is the sum of the `(2 * m + k)`-th and `k`-th Chebyshev polynomials of the first
  kind.
* `polynomial.chebyshev.T_mul`, the `(m * n)`-th Chebyshev polynomial of the first kind is the
  composition of the `m`-th and `n`-th Chebyshev polynomials of the first kind.

## Implementation details

Since Chebyshev polynomials have interesting behaviour over the complex numbers and modulo `p`,
we define them to have coefficients in an arbitrary commutative ring, even though
technically `ℤ` would suffice.
The benefit of allowing arbitrary coefficient rings, is that the statements afterwards are clean,
and do not have `map (int.cast_ring_hom R)` interfering all the time.

## References

[Lionel Ponton, _Roots of the Chebyshev polynomials: A purely algebraic approach_]
[ponton2020chebyshev]

## TODO

* Redefine and/or relate the definition of Chebyshev polynomials to `linear_recurrence`.
* Add explicit formula involving square roots for Chebyshev polynomials
* Compute zeroes and extrema of Chebyshev polynomials.
* Prove that the roots of the Chebyshev polynomials (except 0) are irrational.
* Prove minimax properties of Chebyshev polynomials.
-/

noncomputable theory
namespace polynomial.chebyshev

open polynomial

variables (R S : Type*) [comm_ring R] [comm_ring S]

/-- `T n` is the `n`-th Chebyshev polynomial of the first kind -/
noncomputable def T : ℕ → polynomial R
| 0       := 1
| 1       := X
| (n + 2) := 2 * X * T (n + 1) - T n

@[simp] lemma T_zero : T R 0 = 1 := rfl
@[simp] lemma T_one : T R 1 = X := rfl
lemma T_two : T R 2 = 2 * X ^ 2 - 1 :=
by simp only [T, sub_left_inj, sq, mul_assoc]
@[simp] lemma T_add_two (n : ℕ) :
  T R (n + 2) = 2 * X * T R (n + 1) - T R n :=
by rw T

lemma T_of_two_le (n : ℕ) (h : 2 ≤ n) :
  T R n = 2 * X * T R (n - 1) - T R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact T_add_two R n
end

variables {R S}

lemma map_T (f : R →+* S) :
  ∀ (n : ℕ), map f (T R n) = T S n
| 0       := by simp only [T_zero, polynomial.map_one]
| 1       := by simp only [T_one, map_X]
| (n + 2) :=
begin
  simp only [T_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0,
             polynomial.map_add, polynomial.map_one],
  rw [map_T (n + 1), map_T n],
end

variables (R S)

/-- `U n` is the `n`-th Chebyshev polynomial of the second kind -/
noncomputable def U : ℕ → polynomial R
| 0       := 1
| 1       := 2 * X
| (n + 2) := 2 * X * U (n + 1) - U n

@[simp] lemma U_zero : U R 0 = 1 := rfl
@[simp] lemma U_one : U R 1 = 2 * X := rfl

@[simp] lemma U_add_two (n : ℕ) :
  U R (n + 2) = 2 * X * U R (n + 1) - U R n :=
by rw U

lemma U_of_two_le (n : ℕ) (h : 2 ≤ n) :
  U R n = 2 * X * U R (n - 1) - U R (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact U_add_two R n
end

lemma U_eq_X_mul_U_add_T :
  ∀ (n : ℕ), U R (n+1) = X * U R n + T R (n+1)
| 0        := by { simp only [U_zero, U_one, T_one], ring }
| 1        := by { simp only [U_one, T_two, U_two], ring }
| (n + 2)  :=
  calc U R (n + 2 + 1) = 2 * X * (X * U R (n + 1) + T R (n + 2)) - (X * U R n + T R (n + 1)) :
            by simp only [U_add_two, U_eq_X_mul_U_add_T n, U_eq_X_mul_U_add_T (n + 1)]
  ... = X * (2 * X * U R (n + 1) - U R n) + (2 * X * T R (n + 2) - T R (n + 1)) : by ring
  ... = X * U R (n + 2) + T R (n + 2 + 1) : by simp only [U_add_two, T_add_two]

lemma T_eq_U_sub_X_mul_U (n : ℕ) :
  T R (n+1) = U R (n+1) - X * U R n :=
by rw [U_eq_X_mul_U_add_T, add_comm (X * U R n), add_sub_cancel]

lemma T_eq_X_mul_T_sub_pol_U :
  ∀ (n : ℕ), T R (n+2) = X * T R (n+1) - (1 - X ^ 2) * U R n
| 0        := by { simp only [T_one, T_two, U_zero], ring }
| 1        := by { simp only [T_add_two, T_zero, T_add_two,
                              U_one, T_one], ring }
| (n + 2)  :=
calc T R (n + 2 + 2)
    = 2 * X * T R (n + 2 + 1) - T R (n + 2) : T_add_two _ _
... = 2 * X * (X * T R (n + 2) - (1 - X ^ 2) * U R (n + 1))
      - (X * T R (n + 1) - (1 - X ^ 2) * U R n) : by simp only [T_eq_X_mul_T_sub_pol_U]
... = X * (2 * X * T R (n + 2) -  T R (n + 1)) - (1 - X ^ 2) * (2 * X * U R (n + 1) - U R n) :
            by ring
... = X * T R (n + 2 + 1) - (1 - X ^ 2) * U R (n + 2) : by rw [T_add_two _ (n + 1), U_add_two]

lemma one_sub_X_sq_mul_U_eq_pol_in_T (n : ℕ) :
  (1 - X ^ 2) * U R n = X * T R (n + 1) - T R (n + 2) :=
by rw [T_eq_X_mul_T_sub_pol_U, ←sub_add, sub_self, zero_add]

variables {R S}

@[simp] lemma map_U (f : R →+* S) :
  ∀ (n : ℕ), map f (U R n) = U S n
| 0       := by simp only [U_zero, polynomial.map_one]
| 1       :=
begin
  simp only [U_one, map_X, polynomial.map_mul, polynomial.map_add, polynomial.map_one],
  change map f (1+1) * X = 2 * X,
  simpa only [polynomial.map_add, polynomial.map_one]
end
| (n + 2) :=
begin
  simp only [U_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0, polynomial.map_add,
             polynomial.map_one],
  rw [map_U (n + 1), map_U n],
end

lemma T_derivative_eq_U :
  ∀ (n : ℕ), derivative (T R (n + 1)) = (n + 1) * U R n
| 0        := by simp only [T_one, U_zero, derivative_X, nat.cast_zero, zero_add, mul_one]
| 1        := by { simp only [T_two, U_one, derivative_sub, derivative_one, derivative_mul,
                              derivative_X_pow, nat.cast_one, nat.cast_two],
                    norm_num }
| (n + 2)  :=
  calc derivative (T R (n + 2 + 1))
      = 2 * T R (n + 2) + 2 * X * derivative (T R (n + 1 + 1)) - derivative (T R (n + 1)) :
              by simp only [T_add_two _ (n + 1), derivative_sub, derivative_mul, derivative_X,
                            derivative_bit0, derivative_one, bit0_zero, zero_mul, zero_add, mul_one]
  ... = 2 * (U R (n + 1 + 1) - X * U R (n + 1)) + 2 * X * ((n + 1 + 1) * U R (n + 1))
        - (n + 1) * U R n : by rw_mod_cast [T_derivative_eq_U, T_derivative_eq_U,
                                            T_eq_U_sub_X_mul_U]
  ... = (n + 1) * (2 * X * U R (n + 1) - U R n) + 2 * U R (n + 2) : by ring
  ... = (n + 1) * U R (n + 2) + 2 * U R (n + 2) : by rw U_add_two
  ... = (n + 2 + 1) * U R (n + 2) : by ring
  ... = (↑(n + 2) + 1) * U R (n + 2) : by norm_cast

lemma one_sub_X_sq_mul_derivative_T_eq_poly_in_T (n : ℕ) :
  (1 - X ^ 2)  * (derivative (T R (n+1))) =
    (n + 1) * (T R n - X * T R (n+1)) :=
  calc
  (1 - X ^ 2)  * (derivative (T R (n+1))) = (1 - X ^ 2 ) * ((n + 1) * U R n) :
            by rw T_derivative_eq_U
  ... = (n + 1) * ((1 - X ^ 2) * U R n) : by ring
  ... = (n + 1) * (X * T R (n + 1) - (2 * X * T R (n + 1) - T R n)) :
            by rw [one_sub_X_sq_mul_U_eq_pol_in_T, T_add_two]
  ... = (n + 1) * (T R n - X * T R (n+1)) : by ring

lemma add_one_mul_T_eq_poly_in_U (n : ℕ) :
  ((n : polynomial R) + 1) * T R (n+1) =
    X * U R n - (1 - X ^ 2) * derivative ( U R n) :=
begin
  have h : derivative (T R (n + 2)) = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
                                      + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n),
  { conv_lhs { rw T_eq_X_mul_T_sub_pol_U },
  simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
  one_mul, T_derivative_eq_U],
  rw [T_eq_U_sub_X_mul_U, nat.cast_bit0, nat.cast_one],
  ring },
  calc ((n : polynomial R) + 1) * T R (n + 1)
      = ((n : polynomial R) + 1 + 1) * (X * U R n + T R (n + 1))
        - X * ((n + 1) * U R n) - (X * U R n + T R (n + 1)) : by ring
  ... = derivative (T R (n + 2)) - X * derivative (T R (n + 1)) - U R (n + 1) :
            by rw [←U_eq_X_mul_U_add_T, ←T_derivative_eq_U, ←nat.cast_one, ←nat.cast_add,
                  nat.cast_one, ←T_derivative_eq_U (n + 1)]
  ... = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
        + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n)
        - X * derivative (T R (n + 1)) - U R (n + 1) : by rw h
  ... = X * U R n - (1 - X ^ 2) * derivative (U R n) : by ring,
end

variables (R)

/-- The product of two Chebyshev polynomials is the sum of two other Chebyshev polynomials. -/
lemma mul_T :
  ∀ m : ℕ, ∀ k,
  2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
| 0 := by simp [two_mul, add_mul]
| 1 := by simp [add_comm]
| (m + 2) := begin
  intros k,
  -- clean up the `T` nat indices in the goal
  suffices : 2 * T R (m + 2) * T R (m + k + 2) = T R (2 * m + k + 4) + T R k,
  { have h_nat₁ : 2 * (m + 2) + k = 2 * m + k + 4 := by ring,
    have h_nat₂ : m + 2 + k = m + k + 2 := by simp [add_comm, add_assoc],
    simpa [h_nat₁, h_nat₂] using this },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m + 1` and
  -- `k + 1`
  have H₁ : 2 * T R (m + 1) * T R (m + k + 2) = T R (2 * m + k + 3) + T R (k + 1),
  { have h_nat₁ : m + 1 + (k + 1) = m + k + 2 := by ring,
    have h_nat₂ : 2 * (m + 1) + (k + 1) = 2 * m + k + 3 := by ring,
    simpa [h_nat₁, h_nat₂] using mul_T (m + 1) (k + 1) },
  -- clean up the `T` nat indices in the inductive hypothesis applied to `m` and `k + 2`
  have H₂ : 2 * T R m * T R (m + k + 2) = T R (2 * m + k + 2) + T R (k + 2),
  { have h_nat₁ : 2 * m + (k + 2) = 2 * m + k + 2 := by simp [add_assoc],
    have h_nat₂ : m + (k + 2) = m + k + 2 := by simp [add_assoc],
    simpa [h_nat₁, h_nat₂] using mul_T m (k + 2) },
  -- state the `T` recurrence relation for a few useful indices
  have h₁ := T_add_two R m,
  have h₂ := T_add_two R (2 * m + k + 2),
  have h₃ := T_add_two R k,
  -- the desired identity is an appropriate linear combination of H₁, H₂, h₁, h₂, h₃
  -- it would be really nice here to have a linear algebra tactic!!
  apply_fun (λ p, 2 * X * p) at H₁,
  apply_fun (λ p, 2 * T R (m + k + 2) * p) at h₁,
  have e₁ := congr (congr_arg has_add.add H₁) h₁,
  have e₂ := congr (congr_arg has_sub.sub e₁) H₂,
  have e₃ := congr (congr_arg has_sub.sub e₂) h₂,
  have e₄ := congr (congr_arg has_sub.sub e₃) h₃,
  rw ← sub_eq_zero at e₄ ⊢,
  rw ← e₄,
  ring,
end

/-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
lemma T_mul :
  ∀ m : ℕ, ∀ n : ℕ, T R (m * n) = (T R m).comp (T R n)
| 0 := by simp
| 1 := by simp
| (m + 2) := begin
  intros n,
  have : 2 * T R n * T R ((m + 1) * n) = T R ((m + 2) * n) + T R (m * n),
  { convert mul_T R n (m * n); ring },
  simp [this, T_mul m, ← T_mul (m + 1)]
end

end polynomial.chebyshev


-- Next time: let's see how the graph theory theorem about the sum of degrees being even is coded in lean.

import combinatorics.simple_graph.connectivity

universe u
variables {V : Type u} (G : simple_graph V)

#print simple_graph.walk -- prints the definition
#check nonempty -- prints the type of the object

-- simple_graph.walk u v  is the type of all walks from u to v

-- prove that if u is adjacent to v then the set of walks from u to v is non-empty

theorem adjacent_to_walk {u v : V} (h : G.adj u v) : nonempty (G.walk u v) :=
⟨simple_graph.walk.cons h simple_graph.walk.nil⟩

theorem adjacent_to_walk' {u v : V} (h : G.adj u v) : nonempty (G.walk u v) :=
begin
  apply nonempty.intro,
  apply simple_graph.walk.cons,
  exact h,
  exact simple_graph.walk.nil,
end

theorem adjacent_to_walk'' {u v : V} (h : G.adj u v) : nonempty (G.walk u v) :=
begin
  have p := @simple_graph.walk.nil _ _ v,
  have q := simple_graph.walk.cons h p,
  use q,
end

theorem temp {u v : V} (w : G.walk u v) (h : w.length = 1) : G.adj u v :=
begin
    have p := @simple_graph.walk.nil _ _ u,
    have := simple_graph.walk.support_eq_cons,
  sorry,
end


theorem add_right_cancel (a t b : ℕ) : a + t = b + t → a = b :=
begin
    intro h,
    induction t with d hd,
    repeat {rw add_zero at h},
    exact h,

    repeat {rw nat.add_succ at h},
    rw hd,
    apply nat.succ.inj h,
end


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

! This file was ported from Lean 3 source module measure_theory.group.add_circle
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.Periodic
import Mathbin.Data.Zmod.Quotient

/-!
# Measure-theoretic results about the additive circle

The file is a place to collect measure-theoretic results about the additive circle.

## Main definitions:

 * `add_circle.closed_ball_ae_eq_ball`: open and closed balls in the additive circle are almost
   equal
 * `add_circle.is_add_fundamental_domain_of_ae_ball`: a ball is a fundamental domain for rational
   angle rotation in the additive circle

-/

open Set Function Filter MeasureTheory MeasureTheory.Measure Metric

open MeasureTheory Pointwise BigOperators Topology ENNReal

namespace AddCircle

variable {T : ℝ} [hT : Fact (0 < T)]

include hT

theorem closedBall_ae_eq_ball {x : AddCircle T} {ε : ℝ} : closedBall x ε =ᵐ[volume] ball x ε :=
  by
  cases' le_or_lt ε 0 with hε hε
  · rw [ball_eq_empty.mpr hε, ae_eq_empty, volume_closed_ball,
      min_eq_right (by linarith [hT.out] : 2 * ε ≤ T), ENNReal.ofReal_eq_zero]
    exact mul_nonpos_of_nonneg_of_nonpos zero_le_two hε
  · suffices volume (closed_ball x ε) ≤ volume (ball x ε) by
      exact
        (ae_eq_of_subset_of_measure_ge ball_subset_closed_ball this measurableSet_ball
            (measure_ne_top _ _)).symm
    have : tendsto (fun δ => volume (closed_ball x δ)) (𝓝[<] ε) (𝓝 <| volume (closed_ball x ε)) :=
      by
      simp_rw [volume_closed_ball]
      refine' ENNReal.tendsto_ofReal (tendsto.min tendsto_const_nhds <| tendsto.const_mul _ _)
      convert(@monotone_id ℝ _).tendsto_nhdsWithin_Iio ε
      simp
    refine'
      le_of_tendsto this (mem_nhds_within_Iio_iff_exists_Ioo_subset.mpr ⟨0, hε, fun r hr => _⟩)
    exact measure_mono (closed_ball_subset_ball hr.2)
#align add_circle.closed_ball_ae_eq_ball AddCircle.closedBall_ae_eq_ball

/-- Let `G` be the subgroup of `add_circle T` generated by a point `u` of finite order `n : ℕ`. Then
any set `I` that is almost equal to a ball of radius `T / 2n` is a fundamental domain for the action
of `G` on `add_circle T` by left addition. -/
theorem isAddFundamentalDomainOfAeBall (I : Set <| AddCircle T) (u x : AddCircle T)
    (hu : IsOfFinAddOrder u) (hI : I =ᵐ[volume] ball x (T / (2 * addOrderOf u))) :
    IsAddFundamentalDomain (AddSubgroup.zmultiples u) I :=
  by
  set G := AddSubgroup.zmultiples u
  set n := addOrderOf u
  set B := ball x (T / (2 * n))
  have hn : 1 ≤ (n : ℝ) := by
    norm_cast
    linarith [addOrderOf_pos' hu]
  refine' is_add_fundamental_domain.mk_of_measure_univ_le _ _ _ _
  ·-- `null_measurable_set I volume`
    exact measurable_set_ball.null_measurable_set.congr hI.symm
  · -- `∀ (g : G), g ≠ 0 → ae_disjoint volume (g +ᵥ I) I`
    rintro ⟨g, hg⟩ hg'
    replace hg' : g ≠ 0
    · simpa only [Ne.def, AddSubgroup.mk_eq_zero_iff] using hg'
    change ae_disjoint volume (g +ᵥ I) I
    refine'
      ae_disjoint.congr (Disjoint.aeDisjoint _)
        ((quasi_measure_preserving_add_left volume (-g)).vadd_ae_eq_of_ae_eq g hI) hI
    have hBg : g +ᵥ B = ball (g + x) (T / (2 * n)) := by
      rw [add_comm g x, ← singleton_add_ball _ x g, add_ball, thickening_singleton]
    rw [hBg]
    apply ball_disjoint_ball
    rw [dist_eq_norm, add_sub_cancel, div_mul_eq_div_div, ← add_div, ← add_div, add_self_div_two,
      div_le_iff' (by positivity : 0 < (n : ℝ)), ← nsmul_eq_mul]
    refine'
      (le_add_order_smul_norm_of_is_of_fin_add_order (hu.of_mem_zmultiples hg) hg').trans
        (nsmul_le_nsmul (norm_nonneg g) _)
    exact Nat.le_of_dvd (add_order_of_pos_iff.mpr hu) (addOrderOf_dvd_of_mem_zmultiples hg)
  ·-- `∀ (g : G), quasi_measure_preserving (has_vadd.vadd g) volume volume`
    exact fun g => quasi_measure_preserving_add_left volume g
  · -- `volume univ ≤ ∑' (g : G), volume (g +ᵥ I)`
    replace hI : I =ᵐ[volume] closed_ball x (T / (2 * ↑n)) := hI.trans closed_ball_ae_eq_ball.symm
    haveI : Fintype G := @Fintype.ofFinite _ hu.finite_zmultiples
    have hG_card : (Finset.univ : Finset G).card = n :=
      by
      show _ = addOrderOf u
      rw [add_order_eq_card_zmultiples', Nat.card_eq_fintype_card]
      rfl
    simp_rw [measure_vadd]
    rw [AddCircle.measure_univ, tsum_fintype, Finset.sum_const, measure_congr hI,
      volume_closed_ball, ← ENNReal.ofReal_nsmul, mul_div, mul_div_mul_comm,
      div_self (@two_ne_zero ℝ _ _ _ _), one_mul, min_eq_right (div_le_self hT.out.le hn), hG_card,
      nsmul_eq_mul, mul_div_cancel' T (lt_of_lt_of_le zero_lt_one hn).Ne.symm]
    exact le_refl _
#align add_circle.is_add_fundamental_domain_of_ae_ball AddCircle.isAddFundamentalDomainOfAeBall

theorem volume_of_add_preimage_eq (s I : Set <| AddCircle T) (u x : AddCircle T)
    (hu : IsOfFinAddOrder u) (hs : (u +ᵥ s : Set <| AddCircle T) =ᵐ[volume] s)
    (hI : I =ᵐ[volume] ball x (T / (2 * addOrderOf u))) :
    volume s = addOrderOf u • volume (s ∩ I) :=
  by
  let G := AddSubgroup.zmultiples u
  haveI : Fintype G := @Fintype.ofFinite _ hu.finite_zmultiples
  have hsG : ∀ g : G, (g +ᵥ s : Set <| AddCircle T) =ᵐ[volume] s :=
    by
    rintro ⟨y, hy⟩
    exact (vadd_ae_eq_self_of_mem_zmultiples hs hy : _)
  rw [(is_add_fundamental_domain_of_ae_ball I u x hu hI).measure_eq_card_smul_of_vadd_ae_eq_self s
      hsG,
    add_order_eq_card_zmultiples' u, Nat.card_eq_fintype_card]
#align add_circle.volume_of_add_preimage_eq AddCircle.volume_of_add_preimage_eq

end AddCircle


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Rémy Degenne

! This file was ported from Lean 3 source module probability.process.adapted
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Process.Filtration
import Mathbin.Topology.Instances.Discrete

/-!
# Adapted and progressively measurable processes

This file defines some standard definition from the theory of stochastic processes including
filtrations and stopping times. These definitions are used to model the amount of information
at a specific time and are the first step in formalizing stochastic processes.

## Main definitions

* `measure_theory.adapted`: a sequence of functions `u` is said to be adapted to a
  filtration `f` if at each point in time `i`, `u i` is `f i`-strongly measurable
* `measure_theory.prog_measurable`: a sequence of functions `u` is said to be progressively
  measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
  `set.Iic i × Ω` is strongly measurable with respect to the product `measurable_space` structure
  where the σ-algebra used for `Ω` is `f i`.

## Main results

* `adapted.prog_measurable_of_continuous`: a continuous adapted process is progressively measurable.

## Tags

adapted, progressively measurable

-/

open Filter Order TopologicalSpace

open Classical MeasureTheory NNReal ENNReal Topology BigOperators

namespace MeasureTheory

variable {Ω β ι : Type _} {m : MeasurableSpace Ω} [TopologicalSpace β] [Preorder ι]
  {u v : ι → Ω → β} {f : Filtration ι m}

/-- A sequence of functions `u` is adapted to a filtration `f` if for all `i`,
`u i` is `f i`-measurable. -/
def Adapted (f : Filtration ι m) (u : ι → Ω → β) : Prop :=
  ∀ i : ι, strongly_measurable[f i] (u i)
#align measure_theory.adapted MeasureTheory.Adapted

namespace Adapted

@[protected, to_additive]
theorem mul [Mul β] [ContinuousMul β] (hu : Adapted f u) (hv : Adapted f v) : Adapted f (u * v) :=
  fun i => (hu i).mul (hv i)
#align measure_theory.adapted.mul MeasureTheory.Adapted.mul
#align measure_theory.adapted.add MeasureTheory.Adapted.add

@[protected, to_additive]
theorem div [Div β] [ContinuousDiv β] (hu : Adapted f u) (hv : Adapted f v) : Adapted f (u / v) :=
  fun i => (hu i).div (hv i)
#align measure_theory.adapted.div MeasureTheory.Adapted.div
#align measure_theory.adapted.sub MeasureTheory.Adapted.sub

@[protected, to_additive]
theorem inv [Group β] [TopologicalGroup β] (hu : Adapted f u) : Adapted f u⁻¹ := fun i => (hu i).inv
#align measure_theory.adapted.inv MeasureTheory.Adapted.inv
#align measure_theory.adapted.neg MeasureTheory.Adapted.neg

@[protected]
theorem smul [SMul ℝ β] [ContinuousSMul ℝ β] (c : ℝ) (hu : Adapted f u) : Adapted f (c • u) :=
  fun i => (hu i).const_smul c
#align measure_theory.adapted.smul MeasureTheory.Adapted.smul

@[protected]
theorem stronglyMeasurable {i : ι} (hf : Adapted f u) : strongly_measurable[m] (u i) :=
  (hf i).mono (f.le i)
#align measure_theory.adapted.strongly_measurable MeasureTheory.Adapted.stronglyMeasurable

theorem stronglyMeasurable_le {i j : ι} (hf : Adapted f u) (hij : i ≤ j) :
    strongly_measurable[f j] (u i) :=
  (hf i).mono (f.mono hij)
#align measure_theory.adapted.strongly_measurable_le MeasureTheory.Adapted.stronglyMeasurable_le

end Adapted

theorem adapted_const (f : Filtration ι m) (x : β) : Adapted f fun _ _ => x := fun i =>
  stronglyMeasurable_const
#align measure_theory.adapted_const MeasureTheory.adapted_const

variable (β)

theorem adapted_zero [Zero β] (f : Filtration ι m) : Adapted f (0 : ι → Ω → β) := fun i =>
  @stronglyMeasurable_zero Ω β (f i) _ _
#align measure_theory.adapted_zero MeasureTheory.adapted_zero

variable {β}

theorem Filtration.adapted_natural [MetrizableSpace β] [mβ : MeasurableSpace β] [BorelSpace β]
    {u : ι → Ω → β} (hum : ∀ i, strongly_measurable[m] (u i)) :
    Adapted (Filtration.natural u hum) u := by
  intro i
  refine' strongly_measurable.mono _ (le_supᵢ₂_of_le i (le_refl i) le_rfl)
  rw [stronglyMeasurable_iff_measurable_separable]
  exact ⟨measurable_iff_comap_le.2 le_rfl, (hum i).isSeparable_range⟩
#align measure_theory.filtration.adapted_natural MeasureTheory.Filtration.adapted_natural

/-- Progressively measurable process. A sequence of functions `u` is said to be progressively
measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
`set.Iic i × Ω` is measurable with respect to the product `measurable_space` structure where the
σ-algebra used for `Ω` is `f i`.
The usual definition uses the interval `[0,i]`, which we replace by `set.Iic i`. We recover the
usual definition for index types `ℝ≥0` or `ℕ`. -/
def ProgMeasurable [MeasurableSpace ι] (f : Filtration ι m) (u : ι → Ω → β) : Prop :=
  ∀ i, strongly_measurable[Subtype.measurableSpace.Prod (f i)] fun p : Set.Iic i × Ω => u p.1 p.2
#align measure_theory.prog_measurable MeasureTheory.ProgMeasurable

theorem progMeasurable_const [MeasurableSpace ι] (f : Filtration ι m) (b : β) :
    ProgMeasurable f (fun _ _ => b : ι → Ω → β) := fun i =>
  @stronglyMeasurable_const _ _ (Subtype.measurableSpace.Prod (f i)) _ _
#align measure_theory.prog_measurable_const MeasureTheory.progMeasurable_const

namespace ProgMeasurable

variable [MeasurableSpace ι]

protected theorem adapted (h : ProgMeasurable f u) : Adapted f u :=
  by
  intro i
  have : u i = (fun p : Set.Iic i × Ω => u p.1 p.2) ∘ fun x => (⟨i, set.mem_Iic.mpr le_rfl⟩, x) :=
    rfl
  rw [this]
  exact (h i).compMeasurable measurable_prod_mk_left
#align measure_theory.prog_measurable.adapted MeasureTheory.ProgMeasurable.adapted

protected theorem comp {t : ι → Ω → ι} [TopologicalSpace ι] [BorelSpace ι] [MetrizableSpace ι]
    (h : ProgMeasurable f u) (ht : ProgMeasurable f t) (ht_le : ∀ i ω, t i ω ≤ i) :
    ProgMeasurable f fun i ω => u (t i ω) ω :=
  by
  intro i
  have :
    (fun p : ↥(Set.Iic i) × Ω => u (t (p.fst : ι) p.snd) p.snd) =
      (fun p : ↥(Set.Iic i) × Ω => u (p.fst : ι) p.snd) ∘ fun p : ↥(Set.Iic i) × Ω =>
        (⟨t (p.fst : ι) p.snd, set.mem_Iic.mpr ((ht_le _ _).trans p.fst.prop)⟩, p.snd) :=
    rfl
  rw [this]
  exact (h i).compMeasurable ((ht i).Measurable.subtype_mk.prod_mk measurable_snd)
#align measure_theory.prog_measurable.comp MeasureTheory.ProgMeasurable.comp

section Arithmetic

@[to_additive]
protected theorem mul [Mul β] [ContinuousMul β] (hu : ProgMeasurable f u)
    (hv : ProgMeasurable f v) : ProgMeasurable f fun i ω => u i ω * v i ω := fun i =>
  (hu i).mul (hv i)
#align measure_theory.prog_measurable.mul MeasureTheory.ProgMeasurable.mul
#align measure_theory.prog_measurable.add MeasureTheory.ProgMeasurable.add

@[to_additive]
protected theorem finset_prod' {γ} [CommMonoid β] [ContinuousMul β] {U : γ → ι → Ω → β}
    {s : Finset γ} (h : ∀ c ∈ s, ProgMeasurable f (U c)) : ProgMeasurable f (∏ c in s, U c) :=
  Finset.prod_induction U (ProgMeasurable f) (fun _ _ => ProgMeasurable.mul)
    (progMeasurable_const _ 1) h
#align measure_theory.prog_measurable.finset_prod' MeasureTheory.ProgMeasurable.finset_prod'
#align measure_theory.prog_measurable.finset_sum' MeasureTheory.ProgMeasurable.finset_sum'

@[to_additive]
protected theorem finset_prod {γ} [CommMonoid β] [ContinuousMul β] {U : γ → ι → Ω → β}
    {s : Finset γ} (h : ∀ c ∈ s, ProgMeasurable f (U c)) :
    ProgMeasurable f fun i a => ∏ c in s, U c i a :=
  by
  convert prog_measurable.finset_prod' h
  ext (i a)
  simp only [Finset.prod_apply]
#align measure_theory.prog_measurable.finset_prod MeasureTheory.ProgMeasurable.finset_prod
#align measure_theory.prog_measurable.finset_sum MeasureTheory.ProgMeasurable.finset_sum

@[to_additive]
protected theorem inv [Group β] [TopologicalGroup β] (hu : ProgMeasurable f u) :
    ProgMeasurable f fun i ω => (u i ω)⁻¹ := fun i => (hu i).inv
#align measure_theory.prog_measurable.inv MeasureTheory.ProgMeasurable.inv
#align measure_theory.prog_measurable.neg MeasureTheory.ProgMeasurable.neg

@[to_additive]
protected theorem div [Group β] [TopologicalGroup β] (hu : ProgMeasurable f u)
    (hv : ProgMeasurable f v) : ProgMeasurable f fun i ω => u i ω / v i ω := fun i =>
  (hu i).div (hv i)
#align measure_theory.prog_measurable.div MeasureTheory.ProgMeasurable.div
#align measure_theory.prog_measurable.sub MeasureTheory.ProgMeasurable.sub

end Arithmetic

end ProgMeasurable

theorem progMeasurable_of_tendsto' {γ} [MeasurableSpace ι] [PseudoMetrizableSpace β]
    (fltr : Filter γ) [fltr.ne_bot] [fltr.IsCountablyGenerated] {U : γ → ι → Ω → β}
    (h : ∀ l, ProgMeasurable f (U l)) (h_tendsto : Tendsto U fltr (𝓝 u)) : ProgMeasurable f u :=
  by
  intro i
  apply
    @stronglyMeasurable_of_tendsto (Set.Iic i × Ω) β γ (MeasurableSpace.prod _ (f i)) _ _ fltr _ _ _
      _ fun l => h l i
  rw [tendsto_pi_nhds] at h_tendsto⊢
  intro x
  specialize h_tendsto x.fst
  rw [tendsto_nhds] at h_tendsto⊢
  exact fun s hs h_mem => h_tendsto { g | g x.snd ∈ s } (hs.Preimage (continuous_apply x.snd)) h_mem
#align measure_theory.prog_measurable_of_tendsto' MeasureTheory.progMeasurable_of_tendsto'

theorem progMeasurable_of_tendsto [MeasurableSpace ι] [PseudoMetrizableSpace β] {U : ℕ → ι → Ω → β}
    (h : ∀ l, ProgMeasurable f (U l)) (h_tendsto : Tendsto U atTop (𝓝 u)) : ProgMeasurable f u :=
  progMeasurable_of_tendsto' atTop h h_tendsto
#align measure_theory.prog_measurable_of_tendsto MeasureTheory.progMeasurable_of_tendsto

/-- A continuous and adapted process is progressively measurable. -/
theorem Adapted.progMeasurable_of_continuous [TopologicalSpace ι] [MetrizableSpace ι]
    [SecondCountableTopology ι] [MeasurableSpace ι] [OpensMeasurableSpace ι]
    [PseudoMetrizableSpace β] (h : Adapted f u) (hu_cont : ∀ ω, Continuous fun i => u i ω) :
    ProgMeasurable f u := fun i =>
  @stronglyMeasurable_uncurry_of_continuous_of_stronglyMeasurable _ _ (Set.Iic i) _ _ _ _ _ _ _
    (f i) _ (fun ω => (hu_cont ω).comp continuous_induced_dom) fun j => (h j).mono (f.mono j.Prop)
#align measure_theory.adapted.prog_measurable_of_continuous MeasureTheory.Adapted.progMeasurable_of_continuous

/-- For filtrations indexed by a discrete order, `adapted` and `prog_measurable` are equivalent.
This lemma provides `adapted f u → prog_measurable f u`.
See `prog_measurable.adapted` for the reverse direction, which is true more generally. -/
theorem Adapted.progMeasurable_of_discrete [TopologicalSpace ι] [DiscreteTopology ι]
    [SecondCountableTopology ι] [MeasurableSpace ι] [OpensMeasurableSpace ι]
    [PseudoMetrizableSpace β] (h : Adapted f u) : ProgMeasurable f u :=
  h.progMeasurable_of_continuous fun _ => continuous_of_discreteTopology
#align measure_theory.adapted.prog_measurable_of_discrete MeasureTheory.Adapted.progMeasurable_of_discrete

-- this dot notation will make more sense once we have a more general definition for predictable
theorem Predictable.adapted {f : Filtration ℕ m} {u : ℕ → Ω → β} (hu : Adapted f fun n => u (n + 1))
    (hu0 : strongly_measurable[f 0] (u 0)) : Adapted f u := fun n =>
  match n with
  | 0 => hu0
  | n + 1 => (hu n).mono (f.mono n.le_succ)
#align measure_theory.predictable.adapted MeasureTheory.Predictable.adapted

end MeasureTheory


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Patrick Massot
-/
import tactic.monotonicity

namespace tactic

/-- Apply the function `f` given by `e : pexpr` to the local hypothesis `hyp`, which must either be
of the form `a = b` or `a ≤ b`, replacing the type of `hyp` with `f a = f b` or `f a ≤ f b`. If
`hyp` names an inequality then a new goal `monotone f` is created, unless the name of a proof of
this fact is passed as the optional argument `mono_lem`, or the `mono` tactic can prove it.
-/
meta def apply_fun_to_hyp (e : pexpr) (mono_lem : option pexpr) (hyp : expr) : tactic unit :=
do {
  t ← infer_type hyp,
  prf ← match t with
  | `(%%l = %%r) := do
      ltp ← infer_type l,
      mv ← mk_mvar,
      to_expr ``(congr_arg (%%e : %%ltp → %%mv) %%hyp)
  | `(%%l ≤ %%r) := do
       Hmono ← match mono_lem with
        | some mono_lem :=
          tactic.i_to_expr mono_lem
        | none := do
          n ← get_unused_name `mono,
          to_expr ``(monotone %%e) >>= assert n,
          -- In order to resolve implicit arguments in `%%e`,
          -- we build (and discard) the expression `%%n %%hyp` before calling the `mono` tactic.
          swap,
          n ← get_local n,
          to_expr ``(%%n %%hyp),
          swap,
          do { intro_lst [`x, `y, `h], `[try { dsimp }, mono] } <|> swap,
          return n
        end,
       to_expr ``(%%Hmono %%hyp)
  | _ := fail!"failed to apply {e} at {hyp}"
  end,
  clear hyp,
  hyp ← note hyp.local_pp_name none prf,
  -- let's try to force β-reduction at `h`
  try $ tactic.dsimp_hyp hyp simp_lemmas.mk [] { eta := false, beta := true }
}

/--
Attempt to "apply" a function `f` represented by the argument `e : pexpr` to the goal.

If the goal is of the form `a ≠ b`, we obtain the new goal `f a ≠ f b`.
If the goal is of the form `a = b`, we obtain a new goal `f a = f b`, and a subsidiary goal
`injective f`.
(We attempt to discharge this subsidiary goal automatically, or using the optional argument.)
If the goal is of the form `a ≤ b` (or similarly for `a < b`), and `f` is an `order_iso`,
we obtain a new goal `f a ≤ f b`.
-/
meta def apply_fun_to_goal (e : pexpr) (lem : option pexpr) : tactic unit :=
do t ← target,
  match t with
  | `(%%l ≠ %%r) := to_expr ``(ne_of_apply_ne %%e) >>= apply >> skip
  | `(¬%%l = %%r) := to_expr ``(ne_of_apply_ne %%e) >>= apply >> skip
  | `(%%l ≤ %%r) := to_expr ``((order_iso.le_iff_le %%e).mp) >>= apply >> skip
  | `(%%l < %%r) := to_expr ``((order_iso.lt_iff_lt %%e).mp) >>= apply >> skip
  | `(%%l = %%r) := focus1 (do
      to_expr ``(%%e %%l), -- build and discard an application, to fill in implicit arguments
      n ← get_unused_name `inj,
      to_expr ``(function.injective %%e) >>= assert n,
      -- Attempt to discharge the `injective f` goal
      (focus1 $
      assumption <|>
        (to_expr ``(equiv.injective) >>= apply >> done) <|>
        -- We require that applying the lemma closes the goal, not just makes progress:
        (lem.mmap (λ l, to_expr l >>= apply) >> done))
        <|> swap, -- return to the main goal if we couldn't discharge `injective f`.
      n ← get_local n,
      apply n,
      clear n)
  | _ := fail!"failed to apply {e} to the goal"
  end

namespace interactive

setup_tactic_parser

/--
Apply a function to an equality or inequality in either a local hypothesis or the goal.

* If we have `h : a = b`, then `apply_fun f at h` will replace this with `h : f a = f b`.
* If we have `h : a ≤ b`, then `apply_fun f at h` will replace this with `h : f a ≤ f b`,
  and create a subsidiary goal `monotone f`.
  `apply_fun` will automatically attempt to discharge this subsidiary goal using `mono`,
  or an explicit solution can be provided with `apply_fun f at h using P`, where `P : monotone f`.
* If the goal is `a ≠ b`, `apply_fun f` will replace this with `f a ≠ f b`.
* If the goal is `a = b`, `apply_fun f` will replace this with `f a = f b`,
  and create a subsidiary goal `injective f`.
  `apply_fun` will automatically attempt to discharge this subsidiary goal using local hypotheses,
  or if `f` is actually an `equiv`,
  or an explicit solution can be provided with `apply_fun f using P`, where `P : injective f`.
* If the goal is `a ≤ b` (or similarly for `a < b`), and `f` is actually an `order_iso`,
  `apply_fun f` will replace the goal with `f a ≤ f b`.
  If `f` is anything else (e.g. just a function, or an `equiv`), `apply_fun` will fail.

Typical usage is:
```lean
open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end
```
 -/
meta def apply_fun (q : parse texpr) (locs : parse location) (lem : parse (tk "using" *> texpr)?)
  : tactic unit :=
locs.apply (apply_fun_to_hyp q lem) (apply_fun_to_goal q lem)

add_tactic_doc
{ name       := "apply_fun",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.apply_fun],
  tags       := ["context management"] }

end interactive

end tactic