/-
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.group.hom
import algebra.module.basic
import algebra.module.pi
import algebra.group_action_hom
import algebra.ring.comp_typeclasses

/-!
# (Semi)linear maps

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

open function
open_locale big_operators

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)

end

/-- 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_aut R _ _ : R →+* R) M M₂

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₃]

/-- 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' := zero_smul R (0 : M) ▸ zero_smul R (f.to_fun 0) ▸ f.map_smul' 0 0, ..f }

instance {σ : R →+* S} : has_coe_to_fun (M →ₛₗ[σ] M₃) (λ _, M → M₃) := ⟨linear_map.to_fun⟩

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 :=
by { ext x, refl }

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₃)

@[simp] lemma to_fun_eq_coe : f.to_fun = ⇑f := rfl

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 :=
by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr

@[ext] theorem ext (H : ∀ x, f x = g x) : f = g :=
coe_injective $ funext H

protected lemma congr_arg : Π {x x' : M}, x = x' → f x = f x'
| _ _ rfl := rfl

/-- 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 := h ▸ rfl

theorem ext_iff : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

@[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)

@[simp] lemma map_add (x y : M) : f (x + y) = f x + f y := f.map_add' x y

@[simp] lemma map_smulₛₗ (c : R) (x : M) : f (c • x) = (σ c) • f x := f.map_smul' c x

lemma map_smul (c : R) (x : M) : fₗ (c • x) = c • fₗ x := fₗ.map_smul' c x

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

@[simp] lemma map_zero : f 0 = 0 :=
by { rw [←zero_smul R (0 : M), map_smulₛₗ], simp }

@[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, }⟩

variables (M M₂)
/--
A typeclass for `has_scalar` 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_scalar R M]
  [module S M] [has_scalar 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_scalar R S]
  [has_scalar R M] [module S M] [is_scalar_tower R S M]
  [has_scalar 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_scalar R M]
  [module S M] [has_scalar 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`. -/
@[simps]
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 }

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}

@[simp] lemma map_sum {ι} {t : finset ι} {g : ι → M} :
  f (∑ i in t, g i) = (∑ i in t, f (g i)) :=
f.to_add_monoid_hom.map_sum _ _

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⟩

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

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₂)

@[simp] lemma map_neg (x : M) : f (- x) = - f x :=
f.to_add_monoid_hom.map_neg x

@[simp] lemma map_sub (x y : M) : f (x - y) = f x - f y :=
f.to_add_monoid_hom.map_sub 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₂ (units 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' := f.map_nat_module_smul }

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' := f.map_int_module_smul }

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' := f.map_rat_module_smul, ..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

/-! ### 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₂) :=
{ zero := 0,
  add := (+),
  add_assoc := λ f g h, linear_map.ext $ λ x, add_assoc _ _ _,
  zero_add := λ f, linear_map.ext $ λ x, zero_add _,
  add_zero := λ f, linear_map.ext $ λ x, add_zero _,
  add_comm := λ f g, linear_map.ext $ λ x, add_comm _ _,
  nsmul := λ n f,
  { to_fun := λ x, n • (f x),
    map_add' := λ x y, by rw [f.map_add, smul_add],
    map_smul' := λ c x,
    begin
      rw [f.map_smulₛₗ],
      simp [smul_comm n (σ₁₂ c) (f x)],
    end },
  nsmul_zero' := λ f, linear_map.ext $ λ x, add_comm_monoid.nsmul_zero' _,
  nsmul_succ' := λ n f, linear_map.ext $ λ x, add_comm_monoid.nsmul_succ' _ _ }

/-- 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 negation of a linear map 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_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₂) :=
{ zero := 0,
  add := (+),
  neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := λ f g, linear_map.ext $ λ m, sub_eq_add_neg _ _,
  add_left_neg := λ f, linear_map.ext $ λ m, add_left_neg _,
  nsmul := λ n f,
  { to_fun := λ x, n • (f x),
    map_add' := λ x y, by rw [f.map_add, smul_add],
    map_smul' := λ c x, by rw [f.map_smulₛₗ, smul_comm n (σ₁₂ c) (f x)] },
  zsmul := λ n f,
  { to_fun := λ x, n • (f x),
    map_add' := λ x y, by rw [f.map_add, smul_add],
    map_smul' := λ c x, by rw [f.map_smulₛₗ, smul_comm n (σ₁₂ c) (f x)] },
  zsmul_zero' := λ a, linear_map.ext $ λ m, zero_smul _ _,
  zsmul_succ' := λ n a, linear_map.ext $ λ m, add_comm_group.zsmul_succ' n _,
  zsmul_neg' := λ n a, linear_map.ext $ λ m, add_comm_group.zsmul_neg' n _,
  .. linear_map.add_comm_monoid }

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_scalar
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_scalar 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_scalar 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 →ₛₗ[σ₁₂] 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_scalar

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 := (+),
  npow := @npow_rec _ ⟨(1 : M →ₗ[R] M)⟩ ⟨(*)⟩,
  mul_zero := comp_zero,
  zero_mul := zero_comp,
  left_distrib := λ f g h, comp_add _ _ _,
  right_distrib := λ f g h, add_comp _ _ _,
  .. _root_.module.End.monoid,
  .. linear_map.add_comm_monoid }

instance _root_.module.End.ring : ring (module.End R N₁) :=
{ ..module.End.semiring, ..linear_map.add_comm_group }

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_scalar 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_scalar 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_scalar : has_faithful_scalar (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 }

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_scalar.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 monoid 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 }

end module


/-
Copyright (c) 2023 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler

! This file was ported from Lean 3 source module number_theory.modular_forms.jacobi_theta
! leanprover-community/mathlib commit fe44cd36149e675eb5dec87acc7e8f1d6568e081
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.ModularForms.Basic
import Mathbin.Analysis.SpecialFunctions.Gaussian
import Mathbin.Analysis.Calculus.Series
import Mathbin.Analysis.Complex.LocallyUniformLimit

/-! # Jacobi's theta function

This file defines the Jacobi theta function

$$\theta(\tau) = \sum_{n \in \mathbb{Z}} \exp (i \pi n ^ 2 \tau),$$

and proves the modular transformation properties `θ (τ + 2) = θ τ` and
`θ (-1 / τ) = (-I * τ) ^ (1 / 2) * θ τ`, using Poisson's summation formula for the latter. We also
show that `θ` is differentiable on `ℍ`, and `θ(τ) - 1` has exponential decay as `im τ → ∞`.
-/

open Complex Real Asymptotics

open Real BigOperators UpperHalfPlane Manifold

/-- Jacobi's theta function `∑' (n : ℤ), exp (π * I * n ^ 2 * τ)`. -/
noncomputable def jacobiTheta (τ : ℍ) : ℂ :=
  ∑' n : ℤ, cexp (π * I * n ^ 2 * τ)
#align jacobi_theta jacobiTheta

theorem norm_exp_mul_sq_le {z : ℂ} (hz : 0 < z.im) (n : ℤ) :
    ‖cexp (π * I * n ^ 2 * z)‖ ≤ exp (-π * z.im) ^ n.natAbs :=
  by
  let y := rexp (-π * z.im)
  have h : y < 1 := exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) hz)
  refine' (le_of_eq _).trans (_ : y ^ n ^ 2 ≤ _)
  · rw [Complex.norm_eq_abs, Complex.abs_exp]
    have : (↑π * I * n ^ 2 * z).re = -π * z.im * n ^ 2 :=
      by
      rw [(by
          push_cast
          ring : ↑π * I * n ^ 2 * z = ↑(π * n ^ 2) * (z * I)),
        of_real_mul_re, mul_I_re]
      ring
    obtain ⟨m, hm⟩ := Int.eq_ofNat_of_zero_le (sq_nonneg n)
    rw [this, exp_mul, ← Int.cast_pow, rpow_int_cast, hm, zpow_ofNat]
  · have : n ^ 2 = ↑(n.nat_abs ^ 2) := by rw [Nat.cast_pow, Int.natAbs_sq]
    rw [this, zpow_ofNat]
    exact pow_le_pow_of_le_one (exp_pos _).le h.le ((sq n.nat_abs).symm ▸ n.nat_abs.le_mul_self)
#align norm_exp_mul_sq_le norm_exp_mul_sq_le

theorem exists_summable_bound_exp_mul_sq {R : ℝ} (hR : 0 < R) :
    ∃ bd : ℤ → ℝ,
      Summable bd ∧ ∀ {τ : ℂ} (hτ : R ≤ τ.im) (n : ℤ), ‖cexp (π * I * n ^ 2 * τ)‖ ≤ bd n :=
  by
  let y := rexp (-π * R)
  have h : y < 1 := exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) hR)
  refine' ⟨fun n => y ^ n.natAbs, summable_int_of_summable_nat _ _, fun τ hτ n => _⟩
  pick_goal 3
  · refine' (norm_exp_mul_sq_le (hR.trans_le hτ) n).trans _
    refine' pow_le_pow_of_le_left (exp_pos _).le (real.exp_le_exp.mpr _) _
    rwa [mul_le_mul_left_of_neg (neg_lt_zero.mpr pi_pos)]
  all_goals
    simpa only [Int.natAbs_neg, Int.natAbs_ofNat] using
      summable_geometric_of_lt_1 (Real.exp_pos _).le h
#align exists_summable_bound_exp_mul_sq exists_summable_bound_exp_mul_sq

theorem summable_exp_mul_sq {z : ℂ} (hz : 0 < z.im) :
    Summable fun n : ℤ => cexp (π * I * n ^ 2 * z) :=
  let ⟨bd, h, h'⟩ := exists_summable_bound_exp_mul_sq hz
  summable_norm_iff.mp (summable_of_nonneg_of_le (fun n => norm_nonneg _) (h' <| le_refl _) h)
#align summable_exp_mul_sq summable_exp_mul_sq

theorem jacobiTheta_two_vadd (τ : ℍ) : jacobiTheta ((2 : ℝ) +ᵥ τ) = jacobiTheta τ :=
  by
  refine' tsum_congr fun n => _
  rw [UpperHalfPlane.coe_vadd, of_real_bit0, of_real_one]
  suffices cexp (↑π * I * ↑n ^ 2 * 2) = 1 by rw [mul_add, Complex.exp_add, this, one_mul]
  rw [(by
      push_cast
      ring : ↑π * I * ↑n ^ 2 * 2 = ↑(n ^ 2) * (2 * π * I)),
    Complex.exp_int_mul, Complex.exp_two_pi_mul_i, one_zpow]
#align jacobi_theta_two_vadd jacobiTheta_two_vadd

theorem jacobiTheta_t_sq_smul (τ : ℍ) : jacobiTheta (ModularGroup.t ^ 2 • τ) = jacobiTheta τ :=
  by
  suffices : (2 : ℝ) +ᵥ τ = ModularGroup.t ^ (2 : ℤ) • τ; exact this ▸ jacobiTheta_two_vadd τ
  simp only [← Subtype.coe_inj, UpperHalfPlane.modular_t_zpow_smul, Int.cast_two]
#align jacobi_theta_T_sq_smul jacobiTheta_t_sq_smul

theorem jacobiTheta_s_smul (τ : ℍ) :
    jacobiTheta (ModularGroup.s • τ) = (-I * τ) ^ (1 / 2 : ℂ) * jacobiTheta τ :=
  by
  unfold jacobiTheta
  rw [UpperHalfPlane.modular_s_smul, UpperHalfPlane.coe_mk]
  have ha : 0 < (-I * τ).re :=
    by
    rw [neg_mul, neg_re, mul_re, I_re, I_im, MulZeroClass.zero_mul, one_mul, zero_sub, neg_neg]
    exact τ.im_pos
  have ha' : (-I * τ) ^ (1 / 2 : ℂ) ≠ 0 :=
    by
    rw [Ne.def, cpow_eq_zero_iff]
    contrapose! ha
    rw [ha.1, zero_re]
  have hτ : (τ : ℂ) ≠ 0 := τ.ne_zero
  have := Complex.tsum_exp_neg_mul_int_sq ha
  rw [mul_comm ((1 : ℂ) / _) _, mul_one_div, eq_div_iff ha', mul_comm _ (_ ^ _), eq_comm] at this
  convert this using 3
  · ext1 n
    congr 1
    field_simp [hτ, I_ne_zero]
    ring_nf
    rw [I_sq, mul_neg, mul_one, neg_mul, neg_neg]
  · ext1 n
    congr 1
    ring_nf
#align jacobi_theta_S_smul jacobiTheta_s_smul

theorem hasSum_nat_jacobiTheta (τ : ℍ) :
    HasSum (fun n : ℕ => cexp (π * I * (n + 1) ^ 2 * τ)) ((jacobiTheta τ - 1) / 2) :=
  by
  have := (summable_exp_mul_sq τ.im_pos).HasSum.sum_nat_of_sum_int
  rw [← @hasSum_nat_add_iff' ℂ _ _ _ _ 1] at this
  simp_rw [Finset.sum_range_one, Int.cast_neg, Int.cast_ofNat, Nat.cast_zero, neg_zero,
    Int.cast_zero, sq (0 : ℂ), MulZeroClass.mul_zero, MulZeroClass.zero_mul, neg_sq, ← mul_two,
    Complex.exp_zero, add_sub_assoc, (by norm_num : (1 : ℂ) - 1 * 2 = -1), ← sub_eq_add_neg,
    Nat.cast_add, Nat.cast_one] at this
  convert this.div_const 2
  simp_rw [mul_div_cancel _ two_ne_zero]
#align has_sum_nat_jacobi_theta hasSum_nat_jacobiTheta

theorem jacobiTheta_eq_tsum_nat (τ : ℍ) :
    jacobiTheta τ = 1 + 2 * ∑' n : ℕ, cexp (π * I * (n + 1) ^ 2 * τ) := by
  rw [(hasSum_nat_jacobiTheta τ).tsum_eq, mul_div_cancel' _ (two_ne_zero' ℂ), ← add_sub_assoc,
    add_sub_cancel']
#align jacobi_theta_eq_tsum_nat jacobiTheta_eq_tsum_nat

/-- An explicit upper bound for `‖jacobi_theta τ - 1‖`. -/
theorem norm_jacobiTheta_sub_one_le (τ : ℍ) :
    ‖jacobiTheta τ - 1‖ ≤ 2 / (1 - exp (-π * τ.im)) * exp (-π * τ.im) :=
  by
  suffices ‖∑' n : ℕ, cexp (π * I * (n + 1) ^ 2 * τ)‖ ≤ exp (-π * τ.im) / (1 - exp (-π * τ.im)) by
    calc
      ‖jacobiTheta τ - 1‖ = 2 * ‖∑' n : ℕ, cexp (π * I * (n + 1) ^ 2 * τ)‖ := by
        rw [sub_eq_iff_eq_add'.mpr (jacobiTheta_eq_tsum_nat τ), norm_mul, Complex.norm_eq_abs,
          Complex.abs_two]
      _ ≤ 2 * (rexp (-π * τ.im) / (1 - rexp (-π * τ.im))) := by
        rwa [mul_le_mul_left (zero_lt_two' ℝ)]
      _ = 2 / (1 - rexp (-π * τ.im)) * rexp (-π * τ.im) := by rw [div_mul_comm, mul_comm]

  have : ∀ n : ℕ, ‖cexp (π * I * (n + 1) ^ 2 * τ)‖ ≤ exp (-π * τ.im) ^ (n + 1) :=
    by
    intro n
    simpa only [Int.cast_add, Int.cast_one] using norm_exp_mul_sq_le τ.im_pos (n + 1)
  have s :
    HasSum (fun n : ℕ => rexp (-π * τ.im) ^ (n + 1)) (exp (-π * τ.im) / (1 - exp (-π * τ.im))) :=
    by
    simp_rw [pow_succ, div_eq_mul_inv, hasSum_mul_left_iff (Real.exp_ne_zero _)]
    exact
      hasSum_geometric_of_lt_1 (exp_pos (-π * τ.im)).le
        (exp_lt_one_iff.mpr <| mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) τ.im_pos)
  have aux : Summable fun n : ℕ => ‖cexp (↑π * I * (↑n + 1) ^ 2 * ↑τ)‖ :=
    summable_of_nonneg_of_le (fun n => norm_nonneg _) this s.summable
  exact
    (norm_tsum_le_tsum_norm aux).trans ((tsum_mono aux s.summable this).trans (le_of_eq s.tsum_eq))
#align norm_jacobi_theta_sub_one_le norm_jacobiTheta_sub_one_le

/-- The norm of `jacobi_theta τ - 1` decays exponentially as `im τ → ∞`. -/
theorem isO_atImInfty_jacobiTheta_sub_one :
    IsO UpperHalfPlane.atImInfty (fun τ => jacobiTheta τ - 1) fun τ => rexp (-π * τ.im) :=
  by
  simp_rw [is_O, is_O_with, Filter.Eventually, UpperHalfPlane.atImInfty_mem]
  refine' ⟨2 / (1 - rexp (-π)), 1, fun τ hτ => (norm_jacobiTheta_sub_one_le τ).trans _⟩
  rw [Real.norm_eq_abs, Real.abs_exp]
  refine' mul_le_mul_of_nonneg_right _ (exp_pos _).le
  rw [div_le_div_left (zero_lt_two' ℝ), sub_le_sub_iff_left, exp_le_exp, neg_mul, neg_le_neg_iff]
  · exact le_mul_of_one_le_right pi_pos.le hτ
  · rw [sub_pos, exp_lt_one_iff, neg_mul, neg_lt_zero]
    exact mul_pos pi_pos τ.im_pos
  · rw [sub_pos, exp_lt_one_iff, neg_lt_zero]
    exact pi_pos
#align is_O_at_im_infty_jacobi_theta_sub_one isO_atImInfty_jacobiTheta_sub_one

theorem differentiableAt_tsum_exp_mul_sq (τ : ℍ) :
    DifferentiableAt ℂ (fun z => ∑' n : ℤ, cexp (π * I * n ^ 2 * z)) ↑τ :=
  by
  suffices :
    ∀ (y : ℝ) (hy : 0 < y),
      DifferentiableOn ℂ (fun z => ∑' n : ℤ, cexp (π * I * n ^ 2 * z)) { w : ℂ | y < im w }
  exact
    let ⟨y, hy, hy'⟩ := exists_between τ.im_pos
    (this y hy).DifferentiableAt
      ((complex.continuous_im.is_open_preimage _ isOpen_Ioi).mem_nhds (τ.coe_im ▸ hy'))
  intro y hy
  have h1 :
    ∀ (n : ℤ) (w : ℂ) (hw : y < im w),
      DifferentiableWithinAt ℂ (fun v : ℂ => cexp (↑π * I * ↑n ^ 2 * v)) { z : ℂ | y < im z } w :=
    fun n w hw => (differentiable_at_id.const_mul _).cexp.DifferentiableWithinAt
  have h2 : IsOpen { w : ℂ | y < im w } := continuous_im.is_open_preimage _ isOpen_Ioi
  obtain ⟨bd, bd_s, le_bd⟩ := exists_summable_bound_exp_mul_sq hy
  exact differentiable_on_tsum_of_summable_norm bd_s h1 h2 fun i w hw => le_bd (le_of_lt hw) i
#align differentiable_at_tsum_exp_mul_sq differentiableAt_tsum_exp_mul_sq

theorem mdifferentiable_jacobiTheta : Mdifferentiable 𝓘(ℂ) 𝓘(ℂ) jacobiTheta := fun τ =>
  (differentiableAt_tsum_exp_mul_sq τ).MdifferentiableAt.comp τ τ.mdifferentiable_coe
#align mdifferentiable_jacobi_theta mdifferentiable_jacobiTheta

theorem continuous_jacobiTheta : Continuous jacobiTheta :=
  mdifferentiable_jacobiTheta.Continuous
#align continuous_jacobi_theta continuous_jacobiTheta


/-
Copyright (c) 2021 Alena Gusakov, Bhavik Mehta, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov, Bhavik Mehta, Kyle Miller
-/
import data.fintype.basic
import data.rel
import data.set.finite

/-!
# Hall's Marriage Theorem

Given a list of finite subsets $X_1,X_2,\dots,X_n$ of some given set
$S$, Hall in [Hall1935] gave a necessary and sufficient condition for
there to be a list of distinct elements $x_1,x_2,\dots,x_n$ with
$x_i\in X_i$ for each $i$: it is when for each $k$, the union of every
$k$ of these subsets has at least $k$ elements.

This file proves this for an indexed family `t : ι → finset α` of
finite sets, with `[fintype ι]`, along with some variants of the
statement.  The list of distinct representatives is given by an
injective function `f : ι → α` such that `∀ i, f i ∈ t i`.

A description of this formalization is in [Gusakov2021].

## Main statements
* `finset.all_card_le_bUnion_card_iff_exists_injective` is in terms of `t : ι → finset α`.
* `fintype.all_card_le_rel_image_card_iff_exists_injective` is in terms of a relation
  `r : α → β → Prop` such that `rel.image r {a}` is a finite set for all `a : α`.
* `fintype.all_card_le_filter_rel_iff_exists_injective` is in terms of a relation
  `r : α → β → Prop` on finite types, with the Hall condition given in terms of
  `finset.univ.filter`.

## Todo

* The theorem is still true even if `ι` is not a finite type.  The infinite case
  follows from a compactness argument.
* The statement of the theorem in terms of bipartite graphs is in preparation.

## Tags

Hall's Marriage Theorem, indexed families
-/

open finset

universes u v

namespace hall_marriage_theorem

variables {ι : Type u} {α : Type v} [fintype ι]

theorem hall_hard_inductive_zero (t : ι → finset α) (hn : fintype.card ι = 0) :
  ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x :=
begin
  rw fintype.card_eq_zero_iff at hn,
  exact ⟨λ x, (hn x).elim, by tauto⟩,
end

variables {t : ι → finset α} [decidable_eq α]

lemma hall_cond_of_erase {x : ι} (a : α)
  (ha : ∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card)
  (s' : finset {x' : ι | x' ≠ x}) :
  s'.card ≤ (s'.bUnion (λ x', (t x').erase a)).card :=
begin
  haveI := classical.dec_eq ι,
  specialize ha (s'.image coe),
  rw [nonempty.image_iff, finset.card_image_of_injective s' subtype.coe_injective] at ha,
  by_cases he : s'.nonempty,
  { have ha' : s'.card < (s'.bUnion (λ x, t x)).card,
    { specialize ha he (λ h, by { have h' := mem_univ x, rw ←h at h', simpa using h' }),
      convert ha using 2,
      ext x,
      simp only [mem_image, mem_bUnion, exists_prop, set_coe.exists,
                 exists_and_distrib_right, exists_eq_right, subtype.coe_mk], },
    rw ←erase_bUnion,
    by_cases hb : a ∈ s'.bUnion (λ x, t x),
    { rw card_erase_of_mem hb,
      exact nat.le_pred_of_lt ha' },
    { rw erase_eq_of_not_mem hb,
      exact nat.le_of_lt ha' }, },
  { rw [nonempty_iff_ne_empty, not_not] at he,
    subst s',
    simp },
end

/--
First case of the inductive step: assuming that
`∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card`
and that the statement of Hall's Marriage Theorem is true for all
`ι'` of cardinality ≤ `n`, then it is true for `ι` of cardinality `n + 1`.
-/
lemma hall_hard_inductive_step_A {n : ℕ} (hn : fintype.card ι = n + 1)
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card)
  (ih : ∀ {ι' : Type u} [fintype ι'] (t' : ι' → finset α),
        by exactI fintype.card ι' ≤ n →
                  (∀ (s' : finset ι'), s'.card ≤ (s'.bUnion t').card) →
                  ∃ (f : ι' → α), function.injective f ∧ ∀ x, f x ∈ t' x)
  (ha : ∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card) :
  ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x :=
begin
  haveI : nonempty ι := fintype.card_pos_iff.mp (hn.symm ▸ nat.succ_pos _),
  haveI := classical.dec_eq ι,
  /- Choose an arbitrary element `x : ι` and `y : t x`. -/
  let x := classical.arbitrary ι,
  have tx_ne : (t x).nonempty,
  { rw ←finset.card_pos,
    apply nat.lt_of_lt_of_le nat.one_pos,
    convert ht {x},
    rw finset.singleton_bUnion, },
  rcases classical.indefinite_description _ tx_ne with ⟨y, hy⟩,
  /- Restrict to everything except `x` and `y`. -/
  let ι' := {x' : ι | x' ≠ x},
  let t' : ι' → finset α := λ x', (t x').erase y,
  have card_ι' : fintype.card ι' = n,
  { convert congr_arg (λ m, m - 1) hn,
    convert set.card_ne_eq _, },
  rcases ih t' card_ι'.le (hall_cond_of_erase y ha) with ⟨f', hfinj, hfr⟩,
  /- Extend the resulting function. -/
  refine ⟨λ z, if h : z = x then y else f' ⟨z, h⟩, _, _⟩,
  { rintro z₁ z₂,
    have key : ∀ {x}, y ≠ f' x,
    { intros x h,
      specialize hfr x,
      rw ←h at hfr,
      simpa using hfr, },
    by_cases h₁ : z₁ = x; by_cases h₂ : z₂ = x; simp [h₁, h₂, hfinj.eq_iff, key, key.symm], },
  { intro z,
    split_ifs with hz,
    { rwa hz },
    { specialize hfr ⟨z, hz⟩,
      rw mem_erase at hfr,
      exact hfr.2, }, },
end

lemma hall_cond_of_restrict {ι : Type u} {t : ι → finset α} {s : finset ι}
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card)
  (s' : finset (s : set ι)) :
  s'.card ≤ (s'.bUnion (λ a', t a')).card :=
begin
  haveI := classical.dec_eq ι,
  convert ht (s'.image coe) using 1,
  { rw card_image_of_injective _ subtype.coe_injective, },
  { apply congr_arg,
    ext y,
    simp, },
end

lemma hall_cond_of_compl {ι : Type u} {t : ι → finset α} {s : finset ι}
  (hus : s.card = (s.bUnion t).card)
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card)
  (s' : finset (sᶜ : set ι)) :
  s'.card ≤ (s'.bUnion (λ x', t x' \ s.bUnion t)).card :=
begin
  haveI := classical.dec_eq ι,
  have : s'.card = (s ∪ s'.image coe).card - s.card,
  { rw [card_disjoint_union, nat.add_sub_cancel_left,
        card_image_of_injective _ subtype.coe_injective],
    simp only [disjoint_left, not_exists, mem_image, exists_prop, set_coe.exists,
               exists_and_distrib_right, exists_eq_right, subtype.coe_mk],
    intros x hx hc h,
    exact (hc hx).elim },
  rw [this, hus],
  apply (nat.sub_le_sub_right (ht _) _).trans _,
  rw ← card_sdiff,
  { have : (s ∪ s'.image subtype.val).bUnion t \ s.bUnion t ⊆ s'.bUnion (λ x', t x' \ s.bUnion t),
    { intros t,
      simp only [mem_bUnion, mem_sdiff, not_exists, mem_image, and_imp, mem_union,
                 exists_and_distrib_right, exists_imp_distrib],
      rintro x (hx | ⟨x', hx', rfl⟩) rat hs,
      { exact (hs x hx rat).elim },
      { exact ⟨⟨x', hx', rat⟩, hs⟩, } },
    exact (card_le_of_subset this).trans le_rfl, },
  { apply bUnion_subset_bUnion_of_subset_left,
    apply subset_union_left }
end

/--
Second case of the inductive step: assuming that
`∃ (s : finset ι), s ≠ univ → s.card = (s.bUnion t).card`
and that the statement of Hall's Marriage Theorem is true for all
`ι'` of cardinality ≤ `n`, then it is true for `ι` of cardinality `n + 1`.
-/
lemma hall_hard_inductive_step_B {n : ℕ} (hn : fintype.card ι = n + 1)
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card)
  (ih : ∀ {ι' : Type u} [fintype ι'] (t' : ι' → finset α),
        by exactI fintype.card ι' ≤ n →
                  (∀ (s' : finset ι'), s'.card ≤ (s'.bUnion t').card) →
                  ∃ (f : ι' → α), function.injective f ∧ ∀ x, f x ∈ t' x)
  (s : finset ι)
  (hs : s.nonempty)
  (hns : s ≠ univ)
  (hus : s.card = (s.bUnion t).card) :
  ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x :=
begin
  haveI := classical.dec_eq ι,
  /- Restrict to `s` -/
  let ι' := (s : set ι),
  let t' : ι' → finset α := λ x', t x',
  rw nat.add_one at hn,
  have card_ι'_le : fintype.card ι' ≤ n,
  { apply nat.le_of_lt_succ,
    rw ←hn,
    convert (card_lt_iff_ne_univ _).mpr hns,
    convert fintype.card_coe _ },
  rcases ih t' card_ι'_le (hall_cond_of_restrict ht) with ⟨f', hf', hsf'⟩,
  /- Restrict to `sᶜ` in the domain and `(s.bUnion t)ᶜ` in the codomain. -/
  let ι'' := (s : set ι)ᶜ,
  let t'' : ι'' → finset α := λ a'', t a'' \ s.bUnion t,
  have card_ι''_le : fintype.card ι'' ≤ n,
  { apply nat.le_of_lt_succ,
    rw ←hn,
    convert (card_compl_lt_iff_nonempty _).mpr hs,
    convert fintype.card_coe _,
    rw coe_compl, },
  rcases ih t'' card_ι''_le (hall_cond_of_compl hus ht) with ⟨f'', hf'', hsf''⟩,
  /- Put them together -/
  have f'_mem_bUnion : ∀ {x'} (hx' : x' ∈ s), f' ⟨x', hx'⟩ ∈ s.bUnion t,
  { intros x' hx',
    rw mem_bUnion,
    exact ⟨x', hx', hsf' _⟩, },
  have f''_not_mem_bUnion : ∀ {x''} (hx'' : ¬ x'' ∈ s), ¬ f'' ⟨x'', hx''⟩ ∈ s.bUnion t,
  { intros x'' hx'',
    have h := hsf'' ⟨x'', hx''⟩,
    rw mem_sdiff at h,
    exact h.2, },
  have im_disj : ∀ {x' x'' : ι} {hx' : x' ∈ s} {hx'' : ¬x'' ∈ s}, f' ⟨x', hx'⟩ ≠ f'' ⟨x'', hx''⟩,
  { intros _ _ hx' hx'' h,
    apply f''_not_mem_bUnion hx'',
    rw ←h,
    apply f'_mem_bUnion, },
  refine ⟨λ x, if h : x ∈ s then f' ⟨x, h⟩ else f'' ⟨x, h⟩, _, _⟩,
  { exact hf'.dite _ hf'' @im_disj },
  { intro x,
    split_ifs,
    { exact hsf' ⟨x, h⟩ },
    { exact sdiff_subset _ _ (hsf'' ⟨x, h⟩) } }
end

/--
If `ι` has cardinality `n + 1` and the statement of Hall's Marriage Theorem
is true for all `ι'` of cardinality ≤ `n`, then it is true for `ι`.
-/
theorem hall_hard_inductive_step {n : ℕ} (hn : fintype.card ι = n + 1)
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card)
  (ih : ∀ {ι' : Type u} [fintype ι'] (t' : ι' → finset α),
        by exactI fintype.card ι' ≤ n →
                  (∀ (s' : finset ι'), s'.card ≤ (s'.bUnion t').card) →
                  ∃ (f : ι' → α), function.injective f ∧ ∀ x, f x ∈ t' x) :
  ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x :=
begin
  by_cases h : ∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card,
  { exact hall_hard_inductive_step_A hn ht @ih h, },
  { push_neg at h,
    rcases h with ⟨s, sne, snu, sle⟩,
    have seq := nat.le_antisymm (ht _) sle,
    exact hall_hard_inductive_step_B hn ht @ih s sne snu seq, },
end

/--
Here we combine the base case and the inductive step into
a full strong induction proof, thus completing the proof
of the second direction.
-/
theorem hall_hard_inductive {n : ℕ} (hn : fintype.card ι = n)
  (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card) :
  ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x :=
begin
  tactic.unfreeze_local_instances,
  revert ι,
  refine nat.strong_induction_on n (λ n' ih, _),
  intros _ _ t hn ht,
  rcases n' with (_|_),
  { exact hall_hard_inductive_zero t hn },
  { apply hall_hard_inductive_step hn ht,
    introsI ι' _ _ hι',
    exact ih (fintype.card ι') (nat.lt_succ_of_le hι') rfl, },
end

end hall_marriage_theorem

/--
This the version of Hall's Marriage Theorem in terms of indexed
families of finite sets `t : ι → finset α`.  It states that there is a
set of distinct representatives if and only if every union of `k` of the
sets has at least `k` elements.

Recall that `s.bUnion t` is the union of all the sets `t i` for `i ∈ s`.
-/
theorem finset.all_card_le_bUnion_card_iff_exists_injective
  {ι α : Type*} [fintype ι] [decidable_eq α] (t : ι → finset α) :
  (∀ (s : finset ι), s.card ≤ (s.bUnion t).card) ↔
    (∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x) :=
begin
  split,
  { exact hall_marriage_theorem.hall_hard_inductive rfl },
  { rintro ⟨f, hf₁, hf₂⟩ s,
    rw ←card_image_of_injective s hf₁,
    apply card_le_of_subset,
    intro _,
    rw [mem_image, mem_bUnion],
    rintros ⟨x, hx, rfl⟩,
    exact ⟨x, hx, hf₂ x⟩, },
end

/-- Given a relation such that the image of every singleton set is finite, then the image of every
finite set is finite. -/
instance {α β : Type*} [decidable_eq β]
  (r : α → β → Prop) [∀ (a : α), fintype (rel.image r {a})]
  (A : finset α) : fintype (rel.image r A) :=
begin
  have h : rel.image r A = (A.bUnion (λ a, (rel.image r {a}).to_finset) : set β),
  { ext, simp [rel.image], },
  rw [h],
  apply finset_coe.fintype,
end

/--
This is a version of Hall's Marriage Theorem in terms of a relation
between types `α` and `β` such that `α` is finite and the image of
each `x : α` is finite (it suffices for `β` to be finite).  There is
an injective function `α → β` respecting the relation iff every subset of
`k` terms of `α` is related to at least `k` terms of `β`.

If `[fintype β]`, then `[∀ (a : α), fintype (rel.image r {a})]` is automatically implied.
-/
theorem fintype.all_card_le_rel_image_card_iff_exists_injective
  {α β : Type*} [fintype α] [decidable_eq β]
  (r : α → β → Prop) [∀ (a : α), fintype (rel.image r {a})] :
  (∀ (A : finset α), A.card ≤ fintype.card (rel.image r A)) ↔
    (∃ (f : α → β), function.injective f ∧ ∀ x, r x (f x)) :=
begin
  let r' := λ a, (rel.image r {a}).to_finset,
  have h : ∀ (A : finset α), fintype.card (rel.image r A) = (A.bUnion r').card,
  { intro A,
    rw ←set.to_finset_card,
    apply congr_arg,
    ext b,
    simp [rel.image], },
  have h' : ∀ (f : α → β) x, r x (f x) ↔ f x ∈ r' x,
  { simp [rel.image], },
  simp only [h, h'],
  apply finset.all_card_le_bUnion_card_iff_exists_injective,
end

/--
This is a version of Hall's Marriage Theorem in terms of a relation between finite types.
There is an injective function `α → β` respecting the relation iff every subset of
`k` terms of `α` is related to at least `k` terms of `β`.

It is like `fintype.all_card_le_rel_image_card_iff_exists_injective` but uses `finset.filter`
rather than `rel.image`.
-/
theorem fintype.all_card_le_filter_rel_iff_exists_injective
  {α β : Type*} [fintype α] [fintype β]
  (r : α → β → Prop) [∀ a, decidable_pred (r a)] :
  (∀ (A : finset α), A.card ≤ (univ.filter (λ (b : β), ∃ a ∈ A, r a b)).card) ↔
    (∃ (f : α → β), function.injective f ∧ ∀ x, r x (f x)) :=
begin
  haveI := classical.dec_eq β,
  let r' := λ a, univ.filter (λ b, r a b),
  have h : ∀ (A : finset α), (univ.filter (λ (b : β), ∃ a ∈ A, r a b)) = (A.bUnion r'),
  { intro A,
    ext b,
    simp, },
  have h' : ∀ (f : α → β) x, r x (f x) ↔ f x ∈ r' x,
  { simp, },
  simp_rw [h, h'],
  apply finset.all_card_le_bUnion_card_iff_exists_injective,
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import algebra.direct_sum.module
import data.finsupp.to_dfinsupp

/-!
# Results on direct sums and finitely supported functions.

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

1. The linear equivalence between finitely supported functions `ι →₀ M` and
the direct sum of copies of `M` indexed by `ι`.
-/

universes u v w

noncomputable theory
open_locale direct_sum

open linear_map submodule
variables {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M]

section finsupp_lequiv_direct_sum

variables (R M) (ι : Type*) [decidable_eq ι]

/-- The finitely supported functions `ι →₀ M` are in linear equivalence with the direct sum of
copies of M indexed by ι. -/
def finsupp_lequiv_direct_sum : (ι →₀ M) ≃ₗ[R] ⨁ i : ι, M :=
by haveI : Π m : M, decidable (m ≠ 0) := classical.dec_pred _; exact finsupp_lequiv_dfinsupp R

@[simp] theorem finsupp_lequiv_direct_sum_single (i : ι) (m : M) :
  finsupp_lequiv_direct_sum R M ι (finsupp.single i m) = direct_sum.lof R ι _ i m :=
finsupp.to_dfinsupp_single i m

@[simp] theorem finsupp_lequiv_direct_sum_symm_lof (i : ι) (m : M) :
  (finsupp_lequiv_direct_sum R M ι).symm (direct_sum.lof R ι _ i m) = finsupp.single i m :=
begin
  letI : Π m : M, decidable (m ≠ 0) := classical.dec_pred _,
  exact (dfinsupp.to_finsupp_single i m),
end

end finsupp_lequiv_direct_sum


-- 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) :=
begin
  have p : (G.walk v v):= @simple_graph.walk.nil _ _ v,
  have g_walk : (G.walk u v) := @simple_graph.walk.cons _ _ u v v h p,
  have b : (nonempty (G.walk u v)) := @nonempty.intro _ g_walk,
  exact b,

end

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

end


import mynat.definition -- Imports the natural numbers.
import mynat.add -- imports addition.
import world02.level01 -- hide
import world02.level02 -- hide
import world02.level03 -- hide
import world02.level04 -- hide
import world02.level05 -- hide

namespace mynat -- hide

lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin [nat_num_game]
  /-
  induction c with d hd,
  rw add_zero,
  rw add_zero,
  refl,
  rw add_succ,
  rw add_succ,
  rw succ_add,
  rw hd,
  refl,
  -/
  rw add_assoc,
  rw add_comm b c,
  rw ←  add_assoc,
  refl,
end

end mynat -- hide


import game.world_03_multiplication
import mynat.pow
namespace mynat
def two_eq_succ_one : (2 : mynat) = succ 1 := rfl

lemma zero_pow_zero : (0 : mynat) ^ (0 : mynat) = 1 := begin[nat_num_game]
  rwa pow_zero,
end

lemma zero_pow_succ (m : mynat) : (0 : mynat) ^ (succ m) = 0 := begin[nat_num_game]
  rwa [pow_succ, mul_zero],
end

lemma pow_one (a : mynat) : a ^ (1 : mynat) = a := begin[nat_num_game]
  rwa [one_eq_succ_zero, pow_succ, pow_zero, one_mul],
end

lemma one_pow (m : mynat) : (1 : mynat) ^ m = 1 := begin[nat_num_game]
  induction m,
  rwa pow_zero,
  rwa [pow_succ, mul_one],
end

lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n := begin[nat_num_game]
  induction n,
  rwa [pow_zero, add_zero, mul_one],
  rwa [add_succ, pow_succ, pow_succ, n_ih, mul_assoc],
end

lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n := begin[nat_num_game]
  induction n,
  rwa [pow_zero, pow_zero, pow_zero, mul_one],
  rwa [
    pow_succ, pow_succ, pow_succ, n_ih,
    mul_assoc(a ^ n_n), mul_assoc(a ^ n_n), mul_comm(a), mul_comm(a), mul_assoc
  ],
end

lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) := begin[nat_num_game]
  induction n,
  rwa [mul_zero, pow_zero, pow_zero],
  rwa [mul_succ, pow_add, pow_succ, n_ih],
end

lemma add_squared (a b : mynat) :
    (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b := begin[nat_num_game]
  rwa [
    two_eq_succ_one, one_eq_succ_zero,
    pow_succ, pow_succ, pow_succ, pow_succ, pow_succ, pow_succ,
    pow_zero, pow_zero, pow_zero,
    one_mul, one_mul, one_mul,
    succ_mul, succ_mul,
    zero_mul, zero_add,
    add_mul, add_mul,
    mul_add, mul_add,
    add_assoc, add_assoc,
    add_comm(b*b), add_assoc, mul_comm(b)
  ],
end

end mynat


import category_theory.category.default

universes v u  -- The order in this declaration matters: v often needs to be explicitly specified while u often can be omitted

namespace category_theory

variables (C : Type u) [category.{v} C]

--rewrite this

/-
# Category world

## Level 7: Cancellations

With monomorphisms and epimorphisms, we get some new useful cancellation laws. You will notice that the following two lemmas are pretty similar to the lemma we had in level 5 of world 1. See if you can spot the difference.
-/

/- Lemma
If $$f : X ⟶ Y$$ and $$g : X ⟶ Y$$ are morphisms such that $$f = g$$, then $$f ≫ h = g ≫ h$$.
-/
lemma cancel_epi_id' (X Y : C) (f : X ⟶ Y) [epi f] {h : Y ⟶ Y} : (f ≫ h = f) ↔ h = 𝟙 Y :=
begin
    split,
    intro hyp,
    rw ← category.comp_id f at hyp,
    rw category.assoc at hyp,
    rw category.id_comp at hyp,
    rw ← cancel_epi f,
    exact hyp,

    intro hyp,
    rw hyp,
    exact category.comp_id f,
end

end category_theory


import lib.m154

/-
# Les calculs sont déjà des démonstrations

Au cœur de la notion de calcul en mathématiques se trouve le principe d'égalité de Leibniz :
« deux objets mathématiques sont égaux si et seulement si on peut remplacer l'un par l'autre
dans n'importe quel énoncé sans changer la véracité de l'énoncé ». Pour appliquer ce principe,
il nous faut des théorèmes mathématiques assurant l'égalité de certains objets. Par exemple,
le théorème de commutativité de la multiplication assure que `a * b = b * a` pour tous nombres
`a` et `b`. Un calcul utilisant cette égalité est donc déjà une démonstration mathématique
reposant sur un théorème.

Dans cette première feuille, nous allons explicitement réaliser des calculs par remplacements
successifs dans le but ou les hypothèses. Puis nous verrons comment présenter les choses de
façon plus proche de ce qu'on écrit sur papier, et enfin comment éviter d'avoir à utiliser
directement ces théorèmes.

Dans les exercices suivants on pourra utiliser les faits suivants :
  `mul_assoc a b c : a * b * c = a * (b * c)`
  `mul_comm a b : a * b = b * a`

Dans la formule `a * b * c = a * (b * c)`, il faut comprendre que le membre de gauche signifie
`(a * b) * c`. En cas de doute, la commande `parentheses` permet de forcer l'affichage de parenthèses
autour de toutes les opérations dans l'affichage du contexte et du but courant.

La commande `On réécrit via mul_assoc a b c,` va remplacer `a * b * c` par `a * (b * c)` dans
l'objectif courant.

Pour remplacer de la droite vers la gauche, on utilise
`On réécrit via ← mul_assoc a b c,` qui va remplacer `a * (b * c)` par `a * b * c` dans
l'objectif courant.
-/

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  parentheses, -- On demande à Lean d'afficher des parenthèses autour de toutes les opérations
  On réécrit via mul_comm a b,
  On réécrit via mul_assoc b a c,
end

/-
Voici maintenant la même démonstration avec l'affichage normal, sans la commande `parentheses`.
-/

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  On réécrit via mul_comm a b,
  On réécrit via mul_assoc b a c,
end

/-
C'est à vous de jouer. Remplacez le mot sorry par une démonstration acceptée par l'ordinateur.
-/

example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  sorry
end

/-
N'oubliez pas que pour remplacer de la droite vers la gauche, on utilise
`On réécrit via ← ...`.
-/

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry
end

/-
Reprendre l'exemple précédent en expérimentant ce qui se passe si on ne fournit
pas les arguments aux énoncés `mul_assoc` ou `mul_comm`.
Par exemple on pourra commencer par `On réécrit via ← mul_assoc,` puis tenter
`On réécrit via mul_comm`.
-/

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry
end

/-
On peut aussi réécrire dans une hypothèse du contexte local, en utilisant
par exemple `On réécrit via mul_comm a b dans hyp,` pour remplacer `a * b` par `b * a`
dans l'hypothèse `hyp`.

Dans l'exemple suivant on utilise le fait
`two_mul a : 2 * a = a + a`
et la commande `On conclut par` qui permet de conclure en faisant directement
référence à une hypothèse (nous verrons plus loin que cette commande permet
de faire un peu plus que cela).
-/

example (a b c d : ℝ) (hyp : c = d * a + b) (hyp' : b = a * d) : c = 2 * a * d :=
begin
  On réécrit via hyp' dans hyp,
  On réécrit via mul_comm d a dans hyp,
  On réécrit via ← two_mul (a * d) dans hyp,
  On réécrit via ← mul_assoc 2 a d dans hyp,
  On conclut par hyp,
end

/-
Dans l'exemple suivant, on pourra utiliser
`sub_self x : x - x = 0`
-/

example (a b c d : ℝ) (hyp : c = b * a - d) (hyp' : d = a * b) : c = 0 :=
begin
  sorry
end

/-
La méthode des deux exemples précédents ne ressemble pas à ce qu'on écrit sur
papier. Voici comment présenter les choses autrement.
À l'intérieur de chaque paire d'accolades, l'objectif est l'égalité avec
la formule précédente. Il s'agit d'un point important, prenez le temps de bien
mettre le curseur après chaque accolade ouvrante pour voir quel est le but de chacune
de ces justifications.

Notez aussi l'absence de virgule à la fin des lignes intermédiaires.
-/

example (a b c d : ℝ) (hyp : c = d * a + b) (hyp' : b = a * d) : c = 2 * a * d :=
begin
  calc
    c = d * a + b      : by { On réécrit via hyp }
  ... = d * a + a * d  : by { On réécrit via hyp' }
  ... = a * d + a * d  : by { On réécrit via mul_comm d a }
  ... = 2 * (a * d)    : by { On réécrit via two_mul }
  ... = 2 * a * d      : by { On réécrit via mul_assoc },
end

/-
Reprenons l'autre exemple par cette méthode. Le plus simple est d'écrire
d'abord tout le calcul avec ": by {}" à la fin de chaque ligne puis
de compléter les justifications.
-/

example (a b c d : ℝ) (hyp : c = b * a - d) (hyp' : d = a * b) : c = 0 :=
begin
  sorry
end

/-
Les démonstrations précédentes ont épuisé notre patience avec `mul_comm`
et `mul_assoc`. Il est temps de faire travailler un peu plus l'ordinateur.
-/

example (a b c d : ℝ) (hyp : c = d * a + b) (hyp' : b = a * d) : c = 2 * a * d :=
begin
  calc
    c = d * a + b   : by { On réécrit via hyp }
  ... = d * a + a*d : by { On réécrit via hyp' }
  ... = 2 * a * d   : by { On calcule },
end

/- Vous pouvez aussi utiliser le commande `On calcule` en dehors de la commande
`calc`. -/

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry
end

example (a b : ℝ) : (a + b) + a = 2*a + b :=
begin
  sorry
end
/-
sub_add a b c : a - b + c = a - (b - c)
-/

/-
Si vous êtes en avance et pas encore convaincus par `On calcule`,
démontrer le lemme suivant sans `On calcule`, mais avec une partie des lemmes
suivants (en plus des lemmes déjà mentionés plus haut) :
`pow_two x       : x^2 = x*x`
`mul_add a b c   : a*(b + c) = a*b + a*c`
`add_mul a b c   : (a + b)*c = a*c + b*c`
`mul_sub a b c   : a*(b - c) = a*b - a*c`
`sub_mul a b c   : (a - b)*c = a*c - b*c`
`add_sub a b c   : a + (b - c) = (a + b) - c`
`sub_add a b c   : a - b + c = a - (b - c)`
`add_assoc a b c : (a + b) + c = a + (b + c)`
`sub_sub a b c   : a - b - c = a - (b + c)`
`add_zero a      : a + 0 = a`
`zero_add a      : 0 + a = a`

Aucun des lemmes de cette feuille n'est à retenir pour la suite.
-/

example (a b : ℝ) : (a + b)*(a-b) = a^2 - b^2 :=
begin
  sorry
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Robert Y. Lewis
-/
import data.real.cau_seq

/-!
# Cauchy completion

This file generalizes the Cauchy completion of `(ℚ, abs)` to the completion of a commutative ring
with absolute value.
-/

namespace cau_seq.completion
open cau_seq

section
parameters {α : Type*} [linear_ordered_field α]
parameters {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]

/-- The Cauchy completion of a commutative ring with absolute value. -/
def Cauchy := @quotient (cau_seq _ abv) cau_seq.equiv

/-- The map from Cauchy sequences into the Cauchy completion. -/
def mk : cau_seq _ abv → Cauchy := quotient.mk

@[simp] theorem mk_eq_mk (f) : @eq Cauchy ⟦f⟧ (mk f) := rfl

theorem mk_eq {f g} : mk f = mk g ↔ f ≈ g := quotient.eq

/-- The map from the original ring into the Cauchy completion. -/
def of_rat (x : β) : Cauchy := mk (const abv x)

instance : has_zero Cauchy := ⟨of_rat 0⟩
instance : has_one Cauchy := ⟨of_rat 1⟩
instance : inhabited Cauchy := ⟨0⟩

theorem of_rat_zero : of_rat 0 = 0 := rfl
theorem of_rat_one : of_rat 1 = 1 := rfl

@[simp] theorem mk_eq_zero {f} : mk f = 0 ↔ lim_zero f :=
by have : mk f = 0 ↔ lim_zero (f - 0) := quotient.eq;
   rwa sub_zero at this

instance : has_add Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f + g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
  by simpa [(≈), setoid.r, sub_eq_add_neg, add_comm, add_left_comm, add_assoc]
    using add_lim_zero hf hg⟩

@[simp] theorem mk_add (f g : cau_seq β abv) : mk f + mk g = mk (f + g) := rfl

instance : has_neg Cauchy :=
⟨λ x, quotient.lift_on x (λ f, mk (-f)) $
  λ f₁ f₂ hf, quotient.sound $
  by simpa [neg_sub', (≈), setoid.r] using neg_lim_zero hf⟩

@[simp] theorem mk_neg (f : cau_seq β abv) : -mk f = mk (-f) := rfl

instance : has_mul Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f * g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
  by simpa [(≈), setoid.r, mul_add, mul_comm, add_assoc, sub_eq_add_neg] using
    add_lim_zero (mul_lim_zero_right g₁ hf) (mul_lim_zero_right f₂ hg)⟩

@[simp] theorem mk_mul (f g : cau_seq β abv) : mk f * mk g = mk (f * g) := rfl

instance : has_sub Cauchy :=
⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f - g)) $
  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $ show ((f₁ - g₁) - (f₂ - g₂)).lim_zero,
    by simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using sub_lim_zero hf hg⟩

@[simp] theorem mk_sub (f g : cau_seq β abv) : mk f - mk g = mk (f - g) := rfl

theorem of_rat_add (x y : β) : of_rat (x + y) = of_rat x + of_rat y :=
congr_arg mk (const_add _ _)

theorem of_rat_neg (x : β) : of_rat (-x) = -of_rat x :=
congr_arg mk (const_neg _)

theorem of_rat_mul (x y : β) : of_rat (x * y) = of_rat x * of_rat y :=
congr_arg mk (const_mul _ _)

private lemma zero_def : 0 = mk 0 := rfl

private lemma one_def : 1 = mk 1 := rfl

instance : add_group Cauchy :=
by refine { add := (+), zero := (0 : Cauchy), sub := has_sub.sub, neg := has_neg.neg,
  sub_eq_add_neg := _, nsmul := nsmul_rec, zsmul := zsmul_rec, .. }; try { intros; refl };
{ repeat {refine λ a, quotient.induction_on a (λ _, _)},
  simp [zero_def, add_comm, add_left_comm, sub_eq_neg_add] }

instance : add_group_with_one Cauchy :=
{ nat_cast := λ n, mk n,
  nat_cast_zero := congr_arg mk nat.cast_zero,
  nat_cast_succ := λ n, congr_arg mk (nat.cast_succ n),
  int_cast := λ n, mk n,
  int_cast_of_nat := λ n, congr_arg mk (int.cast_of_nat n),
  int_cast_neg_succ_of_nat := λ n, congr_arg mk (int.cast_neg_succ_of_nat n),
  one := 1,
  .. Cauchy.add_group }

instance : comm_ring Cauchy :=
by refine { add := (+), zero := (0 : Cauchy), mul := (*), one := 1, npow := npow_rec,
    .. Cauchy.add_group_with_one, .. }; try { intros; refl };
{ repeat {refine λ a, quotient.induction_on a (λ _, _)},
  simp [zero_def, one_def, mul_left_comm, mul_comm, mul_add, add_comm, add_left_comm,
          sub_eq_add_neg] }

theorem of_rat_sub (x y : β) : of_rat (x - y) = of_rat x - of_rat y :=
congr_arg mk (const_sub _ _)

end

open_locale classical
section

parameters {α : Type*} [linear_ordered_field α]
parameters {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]
local notation `Cauchy` := @Cauchy _ _ _ _ abv _

noncomputable instance : has_inv Cauchy :=
⟨λ x, quotient.lift_on x
  (λ f, mk $ if h : lim_zero f then 0 else inv f h) $
λ f g fg, begin
  have := lim_zero_congr fg,
  by_cases hf : lim_zero f,
  { simp [hf, this.1 hf, setoid.refl] },
  { have hg := mt this.2 hf, simp [hf, hg],
    have If : mk (inv f hf) * mk f = 1 := mk_eq.2 (inv_mul_cancel hf),
    have Ig : mk (inv g hg) * mk g = 1 := mk_eq.2 (inv_mul_cancel hg),
    rw [mk_eq.2 fg, ← Ig] at If,
    rw mul_comm at Ig,
    rw [← mul_one (mk (inv f hf)), ← Ig, ← mul_assoc, If,
        mul_assoc, Ig, mul_one] }
end⟩

@[simp] theorem inv_zero : (0 : Cauchy)⁻¹ = 0 :=
congr_arg mk $ by rw dif_pos; [refl, exact zero_lim_zero]

@[simp] theorem inv_mk {f} (hf) : (@mk α _ β _ abv _ f)⁻¹ = mk (inv f hf) :=
congr_arg mk $ by rw dif_neg

lemma cau_seq_zero_ne_one : ¬ (0 : cau_seq _ abv) ≈ 1 := λ h,
have lim_zero (1 - 0), from setoid.symm h,
have lim_zero 1, by simpa,
one_ne_zero $ const_lim_zero.1 this

lemma zero_ne_one : (0 : Cauchy) ≠ 1 :=
λ h, cau_seq_zero_ne_one $ mk_eq.1 h

protected theorem inv_mul_cancel {x : Cauchy} : x ≠ 0 → x⁻¹ * x = 1 :=
quotient.induction_on x $ λ f hf, begin
  simp at hf, simp [hf],
  exact quotient.sound (cau_seq.inv_mul_cancel hf)
end

/-- The Cauchy completion forms a field.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def field : field Cauchy :=
{ inv              := has_inv.inv,
  mul_inv_cancel   := λ x x0, by rw [mul_comm, cau_seq.completion.inv_mul_cancel x0],
  exists_pair_ne   := ⟨0, 1, zero_ne_one⟩,
  inv_zero         := inv_zero,
  .. Cauchy.comm_ring }

local attribute [instance] field

theorem of_rat_inv (x : β) : of_rat (x⁻¹) = ((of_rat x)⁻¹ : Cauchy) :=
congr_arg mk $ by split_ifs with h; [simp [const_lim_zero.1 h], refl]

theorem of_rat_div (x y : β) : of_rat (x / y) = (of_rat x / of_rat y : Cauchy) :=
by simp only [div_eq_inv_mul, of_rat_inv, of_rat_mul]

end
end cau_seq.completion

variables {α : Type*} [linear_ordered_field α]
namespace cau_seq
section

variables (β : Type*) [ring β] (abv : β → α) [is_absolute_value abv]

/-- A class stating that a ring with an absolute value is complete, i.e. every Cauchy
sequence has a limit. -/
class is_complete : Prop :=
(is_complete : ∀ s : cau_seq β abv, ∃ b : β, s ≈ const abv b)
end

section

variables {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv]
variable [is_complete β abv]

lemma complete : ∀ s : cau_seq β abv, ∃ b : β, s ≈ const abv b :=
is_complete.is_complete

/-- The limit of a Cauchy sequence in a complete ring. Chosen non-computably. -/
noncomputable def lim (s : cau_seq β abv) : β :=
classical.some (complete s)

lemma equiv_lim (s : cau_seq β abv) : s ≈ const abv (lim s) :=
classical.some_spec (complete s)

lemma eq_lim_of_const_equiv {f : cau_seq β abv} {x : β} (h : cau_seq.const abv x ≈ f) : x = lim f :=
const_equiv.mp $ setoid.trans h $ equiv_lim f

lemma lim_eq_of_equiv_const {f : cau_seq β abv} {x : β} (h : f ≈ cau_seq.const abv x) : lim f = x :=
(eq_lim_of_const_equiv $ setoid.symm h).symm

lemma lim_eq_lim_of_equiv {f g : cau_seq β abv} (h : f ≈ g) : lim f = lim g :=
lim_eq_of_equiv_const $ setoid.trans h $ equiv_lim g

@[simp] lemma lim_const (x : β) : lim (const abv x) = x :=
lim_eq_of_equiv_const $ setoid.refl _

lemma lim_add (f g : cau_seq β abv) : lim f + lim g = lim (f + g) :=
eq_lim_of_const_equiv $ show lim_zero (const abv (lim f + lim g) - (f + g)),
  by rw [const_add, add_sub_add_comm];
  exact add_lim_zero (setoid.symm (equiv_lim f)) (setoid.symm (equiv_lim g))

lemma lim_mul_lim (f g : cau_seq β abv) : lim f * lim g = lim (f * g) :=
eq_lim_of_const_equiv $ show lim_zero (const abv (lim f * lim g) - f * g),
  from have h : const abv (lim f * lim g) - f * g = (const abv (lim f) - f) * g
      + const abv (lim f) * (const abv (lim g) - g) :=
    by simp [const_mul (lim f), mul_add, add_mul, sub_eq_add_neg, add_comm, add_left_comm],
  by rw h; exact add_lim_zero (mul_lim_zero_left _ (setoid.symm (equiv_lim _)))
    (mul_lim_zero_right _ (setoid.symm (equiv_lim _)))

lemma lim_mul (f : cau_seq β abv) (x : β) : lim f * x = lim (f * const abv x) :=
by rw [← lim_mul_lim, lim_const]

lemma lim_neg (f : cau_seq β abv) : lim (-f) = -lim f :=
lim_eq_of_equiv_const (show lim_zero (-f - const abv (-lim f)),
  by rw [const_neg, sub_neg_eq_add, add_comm, ← sub_eq_add_neg];
  exact setoid.symm (equiv_lim f))

lemma lim_eq_zero_iff (f : cau_seq β abv) : lim f = 0 ↔ lim_zero f :=
⟨assume h,
  by have hf := equiv_lim f;
  rw h at hf;
  exact (lim_zero_congr hf).mpr (const_lim_zero.mpr rfl),
assume h,
  have h₁ : f = (f - const abv 0) := ext (λ n, by simp [sub_apply, const_apply]),
  by rw h₁ at h; exact lim_eq_of_equiv_const h ⟩

end

section
variables {β : Type*} [field β] {abv : β → α} [is_absolute_value abv] [is_complete β abv]

lemma lim_inv {f : cau_seq β abv} (hf : ¬ lim_zero f) : lim (inv f hf) = (lim f)⁻¹ :=
have hl : lim f ≠ 0 := by rwa ← lim_eq_zero_iff at hf,
lim_eq_of_equiv_const $ show lim_zero (inv f hf - const abv (lim f)⁻¹),
  from have h₁ : ∀ (g f : cau_seq β abv) (hf : ¬ lim_zero f), lim_zero (g - f * inv f hf * g) :=
    λ g f hf, by rw [← one_mul g, ← mul_assoc, ← sub_mul, mul_one, mul_comm, mul_comm f];
    exact mul_lim_zero_right _ (setoid.symm (cau_seq.inv_mul_cancel _)),
  have h₂ : lim_zero ((inv f hf - const abv (lim f)⁻¹) - (const abv (lim f) - f) *
      (inv f hf * const abv (lim f)⁻¹)) :=
    by rw [sub_mul, ← sub_add, sub_sub, sub_add_eq_sub_sub, sub_right_comm, sub_add];
    exact show lim_zero (inv f hf - const abv (lim f) * (inv f hf * const abv (lim f)⁻¹)
      - (const abv (lim f)⁻¹ - f * (inv f hf * const abv (lim f)⁻¹))),
    from sub_lim_zero
      (by rw [← mul_assoc, mul_right_comm, const_inv hl]; exact h₁ _ _ _)
      (by rw [← mul_assoc]; exact h₁ _ _ _),
  (lim_zero_congr h₂).mpr $ mul_lim_zero_left _ (setoid.symm (equiv_lim f))

end

section
variables [is_complete α abs]

lemma lim_le {f : cau_seq α abs} {x : α}
  (h : f ≤ cau_seq.const abs x) : lim f ≤ x :=
cau_seq.const_le.1 $ cau_seq.le_of_eq_of_le (setoid.symm (equiv_lim f)) h

lemma le_lim {f : cau_seq α abs} {x : α}
  (h : cau_seq.const abs x ≤ f) : x ≤ lim f :=
cau_seq.const_le.1 $ cau_seq.le_of_le_of_eq h (equiv_lim f)

lemma lt_lim {f : cau_seq α abs} {x : α}
  (h : cau_seq.const abs x < f) : x < lim f :=
cau_seq.const_lt.1 $ cau_seq.lt_of_lt_of_eq h (equiv_lim f)

lemma lim_lt {f : cau_seq α abs} {x : α}
  (h : f < cau_seq.const abs x) : lim f < x :=
cau_seq.const_lt.1 $ cau_seq.lt_of_eq_of_lt (setoid.symm (equiv_lim f)) h

end
end cau_seq