/-
Copyright (c) 2022 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle
-/
import algebra.module.basic
import algebra.module.linear_map
import algebra.monoid_algebra.basic
import linear_algebra.dual
import linear_algebra.contraction
import ring_theory.tensor_product

/-!
# Monoid representations

This file introduces monoid representations and their characters and defines a few ways to construct
representations.

## Main definitions

  * representation.representation
  * representation.character
  * representation.tprod
  * representation.lin_hom
  * represensation.dual

## Implementation notes

Representations of a monoid `G` on a `k`-module `V` are implemented as
homomorphisms `G →* (V →ₗ[k] V)`.
-/

open monoid_algebra (lift) (of)
open linear_map

section
variables (k G V : Type*) [comm_semiring k] [monoid G] [add_comm_monoid V] [module k V]

/--
A representation of `G` on the `k`-module `V` is an homomorphism `G →* (V →ₗ[k] V)`.
-/
abbreviation representation := G →* (V →ₗ[k] V)

end

namespace representation

section trivial

variables (k : Type*) {G V : Type*} [comm_semiring k] [monoid G] [add_comm_monoid V] [module k V]

/--
The trivial representation of `G` on a `k`-module V.
-/
def trivial : representation k G V := 1

@[simp]
lemma trivial_def (g : G) (v : V) : trivial k g v = v := rfl

end trivial

section monoid_algebra

variables {k G V : Type*} [comm_semiring k] [monoid G] [add_comm_monoid V] [module k V]
variables (ρ : representation k G V)

/--
A `k`-linear representation of `G` on `V` can be thought of as
an algebra map from `monoid_algebra k G` into the `k`-linear endomorphisms of `V`.
-/
noncomputable def as_algebra_hom : monoid_algebra k G →ₐ[k] (module.End k V) :=
(lift k G _) ρ

lemma as_algebra_hom_def : as_algebra_hom ρ = (lift k G _) ρ :=
rfl

@[simp]
lemma as_algebra_hom_single (g : G) (r : k) :
  (as_algebra_hom ρ (finsupp.single g r)) = r • ρ g :=
by simp only [as_algebra_hom_def, monoid_algebra.lift_single]

lemma as_algebra_hom_single_one (g : G):
  (as_algebra_hom ρ (finsupp.single g 1)) = ρ g :=
by simp

lemma as_algebra_hom_of (g : G) :
  (as_algebra_hom ρ (of k G g)) = ρ g :=
by simp only [monoid_algebra.of_apply, as_algebra_hom_single, one_smul]

/--
If `ρ : representation k G V`, then `ρ.as_module` is a type synonym for `V`,
which we equip with an instance `module (monoid_algebra k G) ρ.as_module`.

You should use `as_module_equiv : ρ.as_module ≃+ V` to translate terms.
-/
@[nolint unused_arguments, derive [add_comm_monoid, module (module.End k V)]]
def as_module (ρ : representation k G V) := V

instance : inhabited ρ.as_module := ⟨0⟩

/--
A `k`-linear representation of `G` on `V` can be thought of as
a module over `monoid_algebra k G`.
-/
noncomputable instance as_module_module : module (monoid_algebra k G) ρ.as_module :=
module.comp_hom V (as_algebra_hom ρ).to_ring_hom

/--
The additive equivalence from the `module (monoid_algebra k G)` to the original vector space
of the representative.

This is just the identity, but it is helpful for typechecking and keeping track of instances.
-/
def as_module_equiv : ρ.as_module ≃+ V :=
add_equiv.refl _

@[simp]
lemma as_module_equiv_map_smul (r : monoid_algebra k G) (x : ρ.as_module) :
  ρ.as_module_equiv (r • x) = ρ.as_algebra_hom r (ρ.as_module_equiv x) :=
rfl

@[simp]
lemma as_module_equiv_symm_map_smul (r : k) (x : V) :
  ρ.as_module_equiv.symm (r • x) =
    algebra_map k (monoid_algebra k G) r • (ρ.as_module_equiv.symm x) :=
begin
  apply_fun ρ.as_module_equiv,
  simp,
end

@[simp]
lemma as_module_equiv_symm_map_rho (g : G) (x : V) :
  ρ.as_module_equiv.symm (ρ g x) = monoid_algebra.of k G g • (ρ.as_module_equiv.symm x) :=
begin
  apply_fun ρ.as_module_equiv,
  simp,
end

/--
Build a `representation k G M` from a `[module (monoid_algebra k G) M]`.

This version is not always what we want, as it relies on an existing `[module k M]`
instance, along with a `[is_scalar_tower k (monoid_algebra k G) M]` instance.

We remedy this below in `of_module`
(with the tradeoff that the representation is defined
only on a type synonym of the original module.)
-/
noncomputable
def of_module' (M : Type*) [add_comm_monoid M] [module k M] [module (monoid_algebra k G) M]
  [is_scalar_tower k (monoid_algebra k G) M] : representation k G M :=
(monoid_algebra.lift k G (M →ₗ[k] M)).symm (algebra.lsmul k M)

section
variables (k G) (M : Type*) [add_comm_monoid M] [module (monoid_algebra k G) M]

/--
Build a `representation` from a `[module (monoid_algebra k G) M]`.

Note that the representation is built on `restrict_scalars k (monoid_algebra k G) M`,
rather than on `M` itself.
-/
noncomputable
def of_module :
  representation k G (restrict_scalars k (monoid_algebra k G) M) :=
(monoid_algebra.lift k G
  (restrict_scalars k (monoid_algebra k G) M →ₗ[k] restrict_scalars k (monoid_algebra k G) M)).symm
  (restrict_scalars.lsmul k (monoid_algebra k G) M)

/-!
## `of_module` and `as_module` are inverses.

This requires a little care in both directions:
this is a categorical equivalence, not an isomorphism.

See `Rep.equivalence_Module_monoid_algebra` for the full statement.

Starting with `ρ : representation k G V`, converting to a module and back again
we have a `representation k G (restrict_scalars k (monoid_algebra k G) ρ.as_module)`.
To compare these, we use the composition of `restrict_scalars_add_equiv` and `ρ.as_module_equiv`.

Similarly, starting with `module (monoid_algebra k G) M`,
after we convert to a representation and back to a module,
we have `module (monoid_algebra k G) (restrict_scalars k (monoid_algebra k G) M)`.
-/

@[simp] lemma of_module_as_algebra_hom_apply_apply
  (r : monoid_algebra k G) (m : restrict_scalars k (monoid_algebra k G) M) :
  ((((of_module k G M).as_algebra_hom) r) m) =
    (restrict_scalars.add_equiv _ _ _).symm (r • restrict_scalars.add_equiv _ _ _ m) :=
begin
  apply monoid_algebra.induction_on r,
  { intros g,
    simp only [one_smul, monoid_algebra.lift_symm_apply, monoid_algebra.of_apply,
      representation.as_algebra_hom_single, representation.of_module,
      add_equiv.apply_eq_iff_eq, restrict_scalars.lsmul_apply_apply], },
  { intros f g fw gw,
    simp only [fw, gw, map_add, add_smul, linear_map.add_apply], },
  { intros r f w,
    simp only [w, alg_hom.map_smul, linear_map.smul_apply,
      restrict_scalars.add_equiv_symm_map_smul_smul], }
end

@[simp]
lemma of_module_as_module_act (g : G) (x : restrict_scalars k (monoid_algebra k G) ρ.as_module) :
  of_module k G (ρ.as_module) g x =
    (restrict_scalars.add_equiv _ _ _).symm ((ρ.as_module_equiv).symm
      (ρ g (ρ.as_module_equiv (restrict_scalars.add_equiv _ _ _ x)))) :=
begin
  apply_fun restrict_scalars.add_equiv _ _ ρ.as_module using
    (restrict_scalars.add_equiv _ _ _).injective,
  dsimp [of_module, restrict_scalars.lsmul_apply_apply],
  simp,
end

lemma smul_of_module_as_module (r : monoid_algebra k G)
  (m : (of_module k G M).as_module) :
   (restrict_scalars.add_equiv _ _ _) ((of_module k G M).as_module_equiv (r • m)) =
     r • (restrict_scalars.add_equiv _ _ _) ((of_module k G M).as_module_equiv m) :=
by { dsimp, simp only [add_equiv.apply_symm_apply, of_module_as_algebra_hom_apply_apply], }

end

end monoid_algebra

section add_comm_group

variables {k G V : Type*} [comm_ring k] [monoid G] [I : add_comm_group V] [module k V]
variables (ρ : representation k G V)

instance : add_comm_group ρ.as_module := I

end add_comm_group

section mul_action
variables (k : Type*) [comm_semiring k] (G : Type*) [monoid G] (H : Type*) [mul_action G H]

/-- A `G`-action on `H` induces a representation `G →* End(k[H])` in the natural way. -/
noncomputable def of_mul_action : representation k G (H →₀ k) :=
{ to_fun := λ g, finsupp.lmap_domain k k ((•) g),
  map_one' := by { ext x y, dsimp, simp },
  map_mul' := λ x y, by { ext z w, simp [mul_smul] }}

variables {k G H}

lemma of_mul_action_def (g : G) : of_mul_action k G H g = finsupp.lmap_domain k k ((•) g) := rfl

lemma of_mul_action_single (g : G) (x : H) (r : k) :
  of_mul_action k G H g (finsupp.single x r) = finsupp.single (g • x) r :=
finsupp.map_domain_single

end mul_action
section group

variables {k G V : Type*} [comm_semiring k] [group G] [add_comm_monoid V] [module k V]
variables (ρ : representation k G V)

@[simp] lemma of_mul_action_apply {H : Type*} [mul_action G H]
  (g : G) (f : H →₀ k) (h : H) : of_mul_action k G H g f h = f (g⁻¹ • h) :=
begin
  conv_lhs { rw ← smul_inv_smul g h, },
  let h' := g⁻¹ • h,
  change of_mul_action k G H g f (g • h') = f h',
  have hg : function.injective ((•) g : H → H), { intros h₁ h₂, simp, },
  simp only [of_mul_action_def, finsupp.lmap_domain_apply, finsupp.map_domain_apply, hg],
end

lemma of_mul_action_self_smul_eq_mul
  (x : monoid_algebra k G) (y : (of_mul_action k G G).as_module) :
  x • y = (x * y : monoid_algebra k G) :=
x.induction_on (λ g, by show as_algebra_hom _ _ _ = _; ext; simp)
  (λ x y hx hy, by simp only [hx, hy, add_mul, add_smul])
  (λ r x hx, by show as_algebra_hom _ _ _ = _; simpa [←hx])

/-- If we equip `k[G]` with the `k`-linear `G`-representation induced by the left regular action of
`G` on itself, the resulting object is isomorphic as a `k[G]`-module to `k[G]` with its natural
`k[G]`-module structure. -/
@[simps] noncomputable def of_mul_action_self_as_module_equiv :
  (of_mul_action k G G).as_module ≃ₗ[monoid_algebra k G] monoid_algebra k G :=
{ map_smul' := of_mul_action_self_smul_eq_mul, ..as_module_equiv _ }

/--
When `G` is a group, a `k`-linear representation of `G` on `V` can be thought of as
a group homomorphism from `G` into the invertible `k`-linear endomorphisms of `V`.
-/
def as_group_hom : G →* units (V →ₗ[k] V) :=
monoid_hom.to_hom_units ρ

end group

section tensor_product

variables {k G V W : Type*} [comm_semiring k] [monoid G]
variables [add_comm_monoid V] [module k V] [add_comm_monoid W] [module k W]
variables (ρV : representation k G V) (ρW : representation k G W)

open_locale tensor_product

/--
Given representations of `G` on `V` and `W`, there is a natural representation of `G` on their
tensor product `V ⊗[k] W`.
-/
def tprod : representation k G (V ⊗[k] W) :=
{ to_fun := λ g, tensor_product.map (ρV g) (ρW g),
  map_one' := by simp only [map_one, tensor_product.map_one],
  map_mul' := λ g h, by simp only [map_mul, tensor_product.map_mul] }

local notation ρV ` ⊗ ` ρW := tprod ρV ρW

@[simp]
lemma tprod_apply (g : G) : (ρV ⊗ ρW) g = tensor_product.map (ρV g) (ρW g) := rfl

lemma smul_tprod_one_as_module (r : monoid_algebra k G) (x : V) (y : W) :
  (r • (x ⊗ₜ y) : (ρV.tprod 1).as_module) = (r • x : ρV.as_module) ⊗ₜ y :=
begin
  show as_algebra_hom _ _ _ = as_algebra_hom _ _ _ ⊗ₜ _,
  simp only [as_algebra_hom_def, monoid_algebra.lift_apply,
    tprod_apply, monoid_hom.one_apply, linear_map.finsupp_sum_apply,
    linear_map.smul_apply, tensor_product.map_tmul, linear_map.one_apply],
  simp only [finsupp.sum, tensor_product.sum_tmul],
  refl,
end

lemma smul_one_tprod_as_module (r : monoid_algebra k G) (x : V) (y : W) :
  (r • (x ⊗ₜ y) : ((1 : representation k G V).tprod ρW).as_module) = x ⊗ₜ (r • y : ρW.as_module) :=
begin
  show as_algebra_hom _ _ _ = _ ⊗ₜ as_algebra_hom _ _ _,
  simp only [as_algebra_hom_def, monoid_algebra.lift_apply,
    tprod_apply, monoid_hom.one_apply, linear_map.finsupp_sum_apply,
    linear_map.smul_apply, tensor_product.map_tmul, linear_map.one_apply],
  simp only [finsupp.sum, tensor_product.tmul_sum, tensor_product.tmul_smul],
end

end tensor_product

section linear_hom

variables {k G V W : Type*} [comm_semiring k] [group G]
variables [add_comm_monoid V] [module k V] [add_comm_monoid W] [module k W]
variables (ρV : representation k G V) (ρW : representation k G W)

/--
Given representations of `G` on `V` and `W`, there is a natural representation of `G` on the
module `V →ₗ[k] W`, where `G` acts by conjugation.
-/
def lin_hom : representation k G (V →ₗ[k] W) :=
{ to_fun := λ g,
  { to_fun := λ f, (ρW g) ∘ₗ f ∘ₗ (ρV g⁻¹),
    map_add' := λ f₁ f₂, by simp_rw [add_comp, comp_add],
    map_smul' := λ r f, by simp_rw [ring_hom.id_apply, smul_comp, comp_smul]},
  map_one' := linear_map.ext $ λ x,
    by simp_rw [coe_mk, inv_one, map_one, one_apply, one_eq_id, comp_id, id_comp],
  map_mul' := λ g h,  linear_map.ext $ λ x,
    by simp_rw [coe_mul, coe_mk, function.comp_apply, mul_inv_rev, map_mul, mul_eq_comp,
                comp_assoc ]}

@[simp]
lemma lin_hom_apply (g : G) (f : V →ₗ[k] W) : (lin_hom ρV ρW) g f = (ρW g) ∘ₗ f ∘ₗ (ρV g⁻¹) := rfl

/--
The dual of a representation `ρ` of `G` on a module `V`, given by `(dual ρ) g f = f ∘ₗ (ρ g⁻¹)`,
where `f : module.dual k V`.
-/
def dual : representation k G (module.dual k V) :=
{ to_fun := λ g,
  { to_fun := λ f, f ∘ₗ (ρV g⁻¹),
    map_add' := λ f₁ f₂, by simp only [add_comp],
    map_smul' := λ r f,
      by {ext, simp only [coe_comp, function.comp_app, smul_apply, ring_hom.id_apply]} },
  map_one' :=
    by {ext, simp only [coe_comp, function.comp_app, map_one, inv_one, coe_mk, one_apply]},
  map_mul' := λ g h,
    by {ext, simp only [coe_comp, function.comp_app, mul_inv_rev, map_mul, coe_mk, mul_apply]}}

@[simp]
lemma dual_apply (g : G) : (dual ρV) g = module.dual.transpose (ρV g⁻¹) := rfl

/--
Given $k$-modules $V, W$, there is a homomorphism $φ : V^* ⊗ W → Hom_k(V, W)$
(implemented by `linear_algebra.contraction.dual_tensor_hom`).
Given representations of $G$ on $V$ and $W$,there are representations of $G$ on  $V^* ⊗ W$ and on
$Hom_k(V, W)$.
This lemma says that $φ$ is $G$-linear.
-/
lemma dual_tensor_hom_comm (g : G) :
  (dual_tensor_hom k V W) ∘ₗ (tensor_product.map (ρV.dual g) (ρW g)) =
  (lin_hom ρV ρW) g ∘ₗ (dual_tensor_hom k V W) :=
begin
  ext, simp [module.dual.transpose_apply],
end

end linear_hom

end representation


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

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `re_clm`
* `im_clm`
* `of_real_clm`
* `conj_cle`

They are bundled versions of the real part, the imaginary part, the embedding of `ℝ` in `ℂ`, and
the complex conjugate as continuous `ℝ`-linear maps. The last two are also bundled as linear
isometries in `of_real_li` and `conj_lie`.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/
noncomputable theory

namespace complex

open_locale complex_conjugate

instance : has_norm ℂ := ⟨abs⟩

instance : normed_group ℂ :=
normed_group.of_core ℂ
{ norm_eq_zero_iff := λ z, abs_eq_zero,
  triangle := abs_add,
  norm_neg := abs_neg }

instance : normed_field ℂ :=
{ norm := abs,
  dist_eq := λ _ _, rfl,
  norm_mul' := abs_mul,
  .. complex.field }

instance : nondiscrete_normed_field ℂ :=
{ non_trivial := ⟨2, by simp [norm]; norm_num⟩ }

instance {R : Type*} [normed_field R] [normed_algebra R ℝ] : normed_algebra R ℂ :=
{ norm_algebra_map_eq := λ x, (abs_of_real $ algebra_map R ℝ x).trans (norm_algebra_map_eq ℝ x),
  to_algebra := complex.algebra }

/-- The module structure from `module.complex_to_real` is a normed space. -/
@[priority 900] -- see Note [lower instance priority]
instance _root_.normed_space.complex_to_real {E : Type*} [normed_group E] [normed_space ℂ E] :
  normed_space ℝ E :=
normed_space.restrict_scalars ℝ ℂ E

@[simp] lemma norm_eq_abs (z : ℂ) : ∥z∥ = abs z := rfl

lemma dist_eq (z w : ℂ) : dist z w = abs (z - w) := rfl

@[simp] lemma norm_real (r : ℝ) : ∥(r : ℂ)∥ = ∥r∥ := abs_of_real _

@[simp] lemma norm_rat (r : ℚ) : ∥(r : ℂ)∥ = |(r : ℝ)| :=
suffices ∥((r : ℝ) : ℂ)∥ = |r|, by simpa,
by rw [norm_real, real.norm_eq_abs]

@[simp] lemma norm_nat (n : ℕ) : ∥(n : ℂ)∥ = n := abs_of_nat _

@[simp] lemma norm_int {n : ℤ} : ∥(n : ℂ)∥ = |n| :=
suffices ∥((n : ℝ) : ℂ)∥ = |n|, by simpa,
by rw [norm_real, real.norm_eq_abs]

lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ∥(n : ℂ)∥ = n :=
by rw [norm_int, _root_.abs_of_nonneg]; exact int.cast_nonneg.2 hn

@[continuity] lemma continuous_abs : continuous abs := continuous_norm

@[continuity] lemma continuous_norm_sq : continuous norm_sq :=
by simpa [← norm_sq_eq_abs] using continuous_abs.pow 2

/-- The `abs` function on `ℂ` is proper. -/
lemma tendsto_abs_cocompact_at_top : filter.tendsto abs (filter.cocompact ℂ) filter.at_top :=
tendsto_norm_cocompact_at_top

/-- The `norm_sq` function on `ℂ` is proper. -/
lemma tendsto_norm_sq_cocompact_at_top :
  filter.tendsto norm_sq (filter.cocompact ℂ) filter.at_top :=
by simpa [mul_self_abs] using
  tendsto_abs_cocompact_at_top.at_top_mul_at_top tendsto_abs_cocompact_at_top

open continuous_linear_map

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_re_le_abs])

@[continuity] lemma continuous_re : continuous re := re_clm.continuous

@[simp] lemma re_clm_coe : (coe (re_clm) : ℂ →ₗ[ℝ] ℝ) = re_lm := rfl

@[simp]

@[simp] lemma re_clm_norm : ∥re_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥re_clm 1∥ : by simp
   ... ≤ ∥re_clm∥ : unit_le_op_norm _ _ (by simp)

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_im_le_abs])

@[continuity] lemma continuous_im : continuous im := im_clm.continuous

@[simp] lemma im_clm_coe : (coe (im_clm) : ℂ →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp] lemma im_clm_apply (z : ℂ) : (im_clm : ℂ → ℝ) z = z.im := rfl

@[simp] lemma im_clm_norm : ∥im_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥im_clm I∥ : by simp
   ... ≤ ∥im_clm∥ : unit_le_op_norm _ _ (by simp)

lemma restrict_scalars_one_smul_right' {E : Type*} [normed_group E] [normed_space ℂ E] (x : E) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) =
    re_clm.smul_right x + I • im_clm.smul_right x :=
by { ext ⟨a, b⟩, simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I] }

lemma restrict_scalars_one_smul_right (x : ℂ) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] ℂ) = x • 1 :=
by { ext1 z, dsimp, apply mul_comm }

/-- The complex-conjugation function from `ℂ` to itself is an isometric linear equivalence. -/
def conj_lie : ℂ ≃ₗᵢ[ℝ] ℂ := ⟨conj_ae.to_linear_equiv, abs_conj⟩

@[simp] lemma conj_lie_apply (z : ℂ) : conj_lie z = conj z := rfl

lemma isometry_conj : isometry (conj : ℂ → ℂ) := conj_lie.isometry

@[continuity] lemma continuous_conj : continuous (conj : ℂ → ℂ) := conj_lie.continuous

/-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/
def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie

@[simp] lemma conj_cle_coe : conj_cle.to_linear_equiv = conj_ae.to_linear_equiv := rfl

@[simp] lemma conj_cle_apply (z : ℂ) : conj_cle z = conj z := rfl

@[simp] lemma conj_cle_norm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥ = 1 :=
conj_lie.to_linear_isometry.norm_to_continuous_linear_map

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_li : ℝ →ₗᵢ[ℝ] ℂ := ⟨of_real_am.to_linear_map, norm_real⟩

lemma isometry_of_real : isometry (coe : ℝ → ℂ) := of_real_li.isometry

@[continuity] lemma continuous_of_real : continuous (coe : ℝ → ℂ) := of_real_li.continuous

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map

@[simp] lemma of_real_clm_coe : (of_real_clm : ℝ →ₗ[ℝ] ℂ) = of_real_am.to_linear_map := rfl

@[simp] lemma of_real_clm_apply (x : ℝ) : of_real_clm x = x := rfl

@[simp] lemma of_real_clm_norm : ∥of_real_clm∥ = 1 := of_real_li.norm_to_continuous_linear_map

noncomputable instance : is_R_or_C ℂ :=
{ re := ⟨complex.re, complex.zero_re, complex.add_re⟩,
  im := ⟨complex.im, complex.zero_im, complex.add_im⟩,
  I := complex.I,
  I_re_ax := by simp only [add_monoid_hom.coe_mk, complex.I_re],
  I_mul_I_ax := by simp only [complex.I_mul_I, eq_self_iff_true, or_true],
  re_add_im_ax := λ z, by simp only [add_monoid_hom.coe_mk, complex.re_add_im,
                                     complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_re_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_re,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_im_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_im,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  mul_re_ax := λ z w, by simp only [complex.mul_re, add_monoid_hom.coe_mk],
  mul_im_ax := λ z w, by simp only [add_monoid_hom.coe_mk, complex.mul_im],
  conj_re_ax := λ z, rfl,
  conj_im_ax := λ z, rfl,
  conj_I_ax := by simp only [complex.conj_I, ring_hom.coe_mk],
  norm_sq_eq_def_ax := λ z, by simp only [←complex.norm_sq_eq_abs, ←complex.norm_sq_apply,
    add_monoid_hom.coe_mk, complex.norm_eq_abs],
  mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im],
  inv_def_ax := λ z, by simp only [complex.inv_def, complex.norm_sq_eq_abs, complex.coe_algebra_map,
    complex.of_real_eq_coe, complex.norm_eq_abs],
  div_I_ax := complex.div_I }

section

variables {α β γ : Type*}
  [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ]

/-- The natural `add_equiv` from `ℂ` to `ℝ × ℝ`. -/
def equiv_real_prod_add_hom : ℂ ≃+ ℝ × ℝ :=
{ map_add' := by simp, .. equiv_real_prod }

/-- The natural `linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
def equiv_real_prod_add_hom_lm : ℂ ≃ₗ[ℝ] ℝ × ℝ :=
{ map_smul' := by simp [equiv_real_prod_add_hom], .. equiv_real_prod_add_hom }

/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
def equiv_real_prodₗ : ℂ ≃L[ℝ] ℝ × ℝ :=
equiv_real_prod_add_hom_lm.to_continuous_linear_equiv

end

lemma has_sum_iff {α} (f : α → ℂ) (c : ℂ) :
  has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im :=
begin
  refine ⟨λ h, ⟨h.mapL re_clm, h.mapL im_clm⟩, _⟩,
  rintro ⟨h₁, h₂⟩,
  convert (h₁.prod_mk h₂).mapL equiv_real_prodₗ.symm.to_continuous_linear_map,
  { ext x; refl },
  { cases c, refl }
end

end complex

namespace is_R_or_C

local notation `reC` := @is_R_or_C.re ℂ _
local notation `imC` := @is_R_or_C.im ℂ _
local notation `IC` := @is_R_or_C.I ℂ _
local notation `absC` := @is_R_or_C.abs ℂ _
local notation `norm_sqC` := @is_R_or_C.norm_sq ℂ _

@[simp] lemma re_to_complex {x : ℂ} : reC x = x.re := rfl
@[simp] lemma im_to_complex {x : ℂ} : imC x = x.im := rfl
@[simp] lemma I_to_complex : IC = complex.I := rfl
@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x :=
by simp [is_R_or_C.norm_sq, complex.norm_sq]
@[simp] lemma abs_to_complex {x : ℂ} : absC x = complex.abs x :=
by simp [is_R_or_C.abs, complex.abs]

end is_R_or_C


import data.list
import tactic
import listplayground

open listplayground

-- THIRD TIME'S THE CHARM??
namespace hanoi

@[derive has_reflect]
structure position := (A : list ℕ) (B : list ℕ) (C : list ℕ)

instance towers_has_repr : has_repr position := ⟨λ t, "A: " ++ t.A.repr ++ " B: " ++ t.B.repr ++ " C: " ++ t.C.repr⟩

#eval position.mk [1, 2] [] []

#check position
#check position.A

-- smoooooosh
def flatten (t : position) : list ℕ := t.A ++ t.B ++ t.C

-- number of disks on the position
def num_disks (t : position) : ℕ := t.A.length + t.B.length + t.C.length

-- is it true any valid tower can get to another valid tower w/equal number of disks?
-- Kevin says yes by induction

def unique_disks (t : position) : Prop := list.nodup (flatten t)
-- ∀ d ∈ (flatten t), (list.filter (λ d', d' = d) (flatten t)) = [d]

-- valid position only have lists that are strictly increasing
-- valid position have no duplicate disks
def valid_tower (t : position) : Prop :=
list.sorted nat.lt t.A ∧ list.sorted nat.lt t.B ∧ list.sorted nat.lt t.C ∧ unique_disks t

#check valid_tower

def valid_tower' (t : position) : Prop :=
list.sorted nat.lt t.A ∧ list.sorted nat.lt t.B ∧ list.sorted nat.lt t.C
∧ list.merge nat.lt (list.merge nat.lt t.A t.B) t.C = list.range' 1 (num_disks t)

#check valid_tower' -- don't reduce this unless you want to make your computer wheeeeze

@[derive has_reflect, derive decidable_eq]
inductive tower : Type
| a | b | c

open tower

def tower_to_string : tower → string
| a := "a" | b := "b" | c := "c"

instance : has_to_string tower := ⟨tower_to_string⟩

def tow (t : position) : tower → list ℕ
| a := t.A
| b := t.B
| c := t.C

example (t : position) : tow t a = t.A := by refl

def move (t : position) : tower → tower → position
| a a := t
| a b := position.mk (t.A.tail) (t.A.head :: t.B) t.C
| a c := position.mk (t.A.tail) t.B (t.A.head :: t.C)
| b a := position.mk (t.B.head :: t.A) (t.B.tail) t.C
| b b := t
| b c := position.mk t.A (t.B.tail) (t.B.head :: t.C)
| c a := position.mk (t.C.head :: t.A) t.B (t.C.tail)
| c b := position.mk t.A (t.C.head :: t.B) (t.C.tail)
| c c := t

@[simp]
lemma move_self (t : position) (s : tower) : move t s s = t := by cases s; refl -- why does rfl not work??

#check move

def valid_move (t : position) : tower → tower → Prop
| a a := true
| a b := t.A ≠ [] ∧ ((t.B ≠ [] ∧ t.A.head < t.B.head) ∨ t.B = [])
| a c := t.A ≠ [] ∧ ((t.C ≠ [] ∧ t.A.head < t.C.head) ∨ t.C = [])
| b a := t.B ≠ [] ∧ ((t.A ≠ [] ∧ t.B.head < t.A.head) ∨ t.A = [])
| b b := true
| b c := t.B ≠ [] ∧ ((t.C ≠ [] ∧ t.B.head < t.C.head) ∨ t.C = [])
| c a := t.C ≠ [] ∧ ((t.A ≠ [] ∧ t.C.head < t.A.head) ∨ t.A = [])
| c b := t.C ≠ [] ∧ ((t.B ≠ [] ∧ t.C.head < t.B.head) ∨ t.B = [])
| c c := true

lemma invalid_move (t : position) (s d : tower) : ¬valid_move t s d ↔ (tow t s = [] ∨ (tow t s ≠ [] ∧ tow t d ≠ [] ∧ tow t d < tow t s)) :=
begin
  split,
  { intros h,
    cases s; cases d;
    try { unfold valid_move at h; exfalso; rw not_true at h, exact h };
    sorry
  },
  { sorry }
end

#check valid_move

-- also rw is huuuuge when we rw h. does not look nice!
example (t : position) (h : t = position.mk [1,2,3] [] []) : move t a b = position.mk [2,3] [1] [] :=
begin
  rw h,
  refl,
end

/- non-inductive definition is a lot of work... -/

def can_get_to_one (t t' : position) : Prop := ∃ (s d : tower), valid_move t s d ∧ move t s d = t'

-- lol is there a way to simplify this?
-- answer: use the inductive definition lmao
def can_get_to_gt_one (t t' : position) : Prop := ∃ (tows : list position), (∃ first ∈ tows, ∃ last ∈ tows, can_get_to_one t first ∧ can_get_to_one last t' ∧ (∀ tow ∈ tows, tow ≠ last → (∃ tow' ∈ tows, tow ≠ tow' ∧ can_get_to_one tow tow')))

def can_get_to (t t' : position) : Prop := can_get_to_one t t' ∨ can_get_to_gt_one t t'

#check can_get_to

lemma can_get_to_one_self (t : position) : can_get_to_one t t :=
begin
  use [a, a],
  split,
  { exact trivial },
  { refl }
end

-- you can always meander and use more moves
lemma can_get_to_one_can_get_to_gt_one (t t' : position) (h : can_get_to_one t t') : can_get_to_gt_one t t' :=
begin
  use [[t], t, t],
  split,
  { exact list.mem_singleton_self _ },
  { split,
    { exact can_get_to_one_self t },
    { split,
      { exact h },
      { intros tow htow_in htow_ne_t,
        rw list.mem_singleton at htow_in,
        contradiction } } }
end

lemma can_get_to_gt_one_self (t : position) : can_get_to_gt_one t t :=
begin
  apply can_get_to_one_can_get_to_gt_one,
  exact can_get_to_one_self t,
end

lemma can_get_to_self (t : position) : can_get_to t t :=
begin
  left,
  exact can_get_to_one_self t,
end

-- not sure how useful this will be
lemma flatten_perm (t : position) (t₁ t₂ t₃ : tower) (h : t₁ ≠ t₂ ∧ t₁ ≠ t₃ ∧ t₂ ≠ t₃) :
flatten t ~ tow t t₁ ++ tow t t₂ ++ tow t t₃ :=
begin
  rcases h with ⟨h₁, h₂, h₃⟩,
  cases t₁; cases t₂; cases t₃;
  try { contradiction }; -- get rid of any cases w/duplicates
  try { unfold flatten, unfold tow },
  { -- a b c ~ a c b
    rw [list.append_assoc, list.append_assoc],
    apply list.perm.append_left,
    exact list.perm_append_comm },
  { -- a b c ~ b a c
    apply list.perm.append_right,
    exact list.perm_append_comm },
  { -- a b c ~ b c a
    rw list.append_assoc,
    exact list.perm_append_comm },
  { -- a b c ~ c a b
    conv_rhs { rw list.append_assoc },
    exact list.perm_append_comm },
  { -- a b c ~ c b a
    have h : t.A ++ t.B ~ t.B ++ t.A := list.perm_append_comm,
    conv_rhs { rw list.append_assoc },
    calc (t.A ++ t.B) ++ t.C ~ t.C ++ (t.A ++ t.B) : list.perm_append_comm
         ... ~ t.C ++ (t.B ++ t.A) : list.perm.append_left t.C h }
end

lemma valid_move_perm (t : position) (s d : tower) (hv : valid_move t s d) : flatten t ~ flatten (move t s d) :=
begin
  cases s; cases d;
  try { rw move_self },
  case a b { apply list.perm.append_right,
             conv_lhs { rw (list.cons_head_tail hv.1).symm },
             rw list.cons_append,
             exact list.perm_middle.symm },
  case a c { have h := flatten_perm (move t a c) c a b (by tauto),
             unfold flatten at ⊢ h, unfold move at ⊢ h, unfold tow at h, dsimp only at ⊢ h,
             conv_lhs { rw <- list.cons_head_tail hv.1 },
             suffices h' : t.A.head :: t.A.tail ++ t.B ++ t.C ~ t.A.head :: t.C ++ t.A.tail ++ t.B,
             { exact list.perm.trans h' (list.perm.symm h) },
             { sorry
             }
           },
  repeat { sorry }
end

lemma valid_move_unique_disks (t : position) (h : unique_disks t) (s d : tower) (hv : valid_move t s d) :
unique_disks (move t s d) :=
begin
  unfold unique_disks,
  cases s; cases d; unfold move;
  sorry
end

lemma move_self_valid_is_valid (t : position) (s : tower) :
valid_tower t ∧ valid_move t s s → valid_tower (move t s s) :=
begin
  intros h,
  rw move_self,
  exact h.1,
end

-- moving to self is always valid
lemma move_self_valid_is_valid' (t : position) (s : tower) :
valid_tower t → valid_tower (move t s s) :=
begin
  intros h,
  rwa move_self,
end

-- a valid move on a valid position results in a valid position
lemma move_valid_is_valid (t : position) (s d : tower) :
valid_tower t ∧ valid_move t s d → valid_tower (move t s d) :=
begin
  rintros ⟨ht, hm⟩,
  cases s; cases d;
  try { exact move_self_valid_is_valid' t _ ht }; -- move to self is valid
  try { rcases ht with ⟨htA, htB, htC, htd⟩, rcases hm with ⟨hml, hmr, hmr'⟩; split };
  try { split }; try { split };
  try { exact list.sorted.tail htA }; -- moving from A guarantees A is still sorted
  try { exact list.sorted.tail htB }; -- moving from B guarantees B is still sorted
  try { exact list.sorted.tail htC }; -- moving from C guarantees C is still sorted
  try { exact htA }; -- A is unaffected
  try { exact htB }; -- B is unaffected
  try { exact htC }; -- C is unaffected
  try { unfold move; rw hm_right; exact list.sorted_singleton _ }, -- moving to nil guarantees sorted
  -- insert perms lemma to prove nodups and thus unique disks
  { exact cons_smol_sorted t.B htB hmr t.A.head hmr' },
  repeat { sorry }
end

-- TODO this is a mess
lemma valid_move_sym (t : position) (s d : tower) : valid_move t s d → valid_move (move t s d) d s :=
begin
  intros h,
  cases s; cases d,
  all_goals {sorry}
end

lemma can_get_to_one_sym (t t' : position) : can_get_to_one t t' → can_get_to_one t' t :=
begin
  intros h,
  rcases h with ⟨s, d, h⟩,
  use [d, s],
  sorry
end

lemma can_get_to_one_can_get_to (t t' : position) : can_get_to_one t t' → can_get_to t t' :=
begin
  intros h,
  left,
  exact h,
end

-- if t₁ can get to t₂ in one move, and t₂ can get to t₃ in one move, then t₁ can get to t₃
lemma can_get_to_one_twice (t₁ t₂ t₃ : position) (h₁ : can_get_to_one t₁ t₂) (h₂ : can_get_to_one t₂ t₃) : can_get_to t₁ t₃ :=
begin
  right,
  use [[t₂], t₂, t₂], -- one middle tower, thus same point of entry/exit
  split,
  { exact list.mem_singleton_self _ },
  { split,
    { exact h₁ },
    { split,
      { exact h₂ },
      { intros tow htow_in htow_ne_last,
        exfalso,
        apply htow_ne_last,
        rwa list.mem_singleton at htow_in } } }
end

-- if t₁ can get to t₂ in one move, and t₂ can get to t₃ in multiple moves, then t₁ can get to t₃
lemma can_get_to_one_gt_one (t₁ t₂ t₃ : position) (h₁ : can_get_to_one t₁ t₂) (h₂ : can_get_to_gt_one t₂ t₃) : can_get_to t₁ t₃ :=
begin
  rcases h₂ with ⟨tows, first, hfirst_in, last, hlast_in, hstart_cgt, hlast_cgt, hmid⟩,
  right,
  use [t₂ :: tows, t₂, list.mem_cons_self _ _, last, list.mem_cons_of_mem t₂ hlast_in],
  split,
  { exact h₁ },
  { split,
    { exact hlast_cgt },
    { intros tow htow_in htow_ne_last,
      cases htow_in,
      { sorry },
      { sorry }
    }
  }
end

-- TODO complicated definitions are leading to misery but ill try it anyways
-- if t₁ can get to t₂, and t₂ can get to t₃, then t₁ can get to t₃
lemma can_get_to_trans (t₁ t₂ t₃ : position) (h₁ : can_get_to t₁ t₂) (h₂ : can_get_to t₂ t₃) : can_get_to t₁ t₃ :=
begin
  cases h₁,
  { cases h₂,
    { -- can get to each other in one move
      exact can_get_to_one_twice t₁ t₂ t₃ h₁ h₂ },
    { -- can get from t₁ to t₂ in one move, but multiple moves from t₂ to t₃
      sorry
    },
  },
  { cases h₂,
    { -- multiple moves to get from t₁ to t₂ but one move from t₂ to t₃
      sorry
    },
    { -- multiple moves from each other
      sorry
    } }
end

/- inductive def should be better -/

-- alternative inductive definition (suggested by Kevin Buzzard! thanks again!)
inductive can_get_to' : position → position → Prop
| can_get_to_self' : ∀ (t : position), can_get_to' t t
| can_get_to_one' : ∀ (t t' : position), can_get_to_one t t' → can_get_to' t t'
| can_get_to_trans' : ∀ (t₁ t₂ t₃ : position), can_get_to' t₁ t₂ → can_get_to' t₂ t₃ → can_get_to' t₁ t₃
-- why does it complain about: can_get_to' t₁ t₂ ∧ can_get_to' t₂ t₃ → can_get_to' t₁ t₃??

#check can_get_to'

open can_get_to'

example (t t' : position) : can_get_to_one t t' → can_get_to' t t':=
begin
  apply can_get_to_one',
end

lemma can_get_to_trans'' (t₁ t₂ t₃ : position) : can_get_to' t₁ t₂ ∧ can_get_to' t₂ t₃ → can_get_to' t₁ t₃ :=
begin
  rintros ⟨h₁, h₂⟩,
  apply can_get_to_trans' t₁ t₂ t₃,
  exact h₁,
  exact h₂,
end

lemma can_get_to_sym' (t t' : position) : can_get_to' t t' ↔ can_get_to' t' t := sorry

-- using the non-inductive definition
def game (disks : ℕ) : Prop :=
can_get_to (position.mk (list.range' 1 disks) [] []) (position.mk [] [] (list.range' 1 disks))

-- using the inductive definition
def game' (disks : ℕ) : Prop :=
can_get_to' (position.mk (list.range' 1 disks) [] []) (position.mk [] [] (list.range' 1 disks))

#check game
#check game'

-- using non-inductive definition
example : game 1 :=
begin
  left,
  use [a, c],
  split,
  { unfold valid_move,
    exact dec_trivial },
  { refl }
end

-- using inductive definition
example : game' 1 :=
begin
  apply can_get_to_one',
  use [a, c],
  split,
  { unfold valid_move,
    exact dec_trivial },
  { refl }
end

-- making applys for tactics?
lemma can_get_to_one_move (t : position) (s d : tower) : valid_move t s d → can_get_to' t (move t s d) :=
begin
  intros h,
  apply can_get_to_one',
  use [s, d],
  split,
  { exact h },
  { refl }
end

lemma can_get_to_one_move_sym (t : position) (s d : tower) : valid_move t d s → can_get_to' (move t d s) t :=
begin
  intros h,
  apply can_get_to_one',
  use [s, d],
  split,
  { exact valid_move_sym t d s h },
  { sorry }
end

lemma fmove' {t₁ t₃ : position} (s d : tower) : valid_move t₁ s d ∧ can_get_to' (move t₁ s d) t₃ → can_get_to' t₁ t₃ :=
begin
  rintros ⟨h₁, h₂⟩,
  apply can_get_to_trans'' t₁ (move t₁ s d) t₃,
  split,
  { apply can_get_to_one_move t₁ s d,
    exact h₁ },
  { exact h₂ }
end

example : game' 1 :=
begin
  apply fmove' tower.a tower.c,
  split,
  unfold valid_move,
  simp,
  unfold move,
  simp,
  exact can_get_to_self' _,
end

lemma bmove' {t₁ t₃ : position} (s d : tower) : valid_move t₃ d s ∧ can_get_to' t₁ (move t₃ d s) → can_get_to' t₁ t₃ :=
begin
  rintros ⟨h₁, h₂⟩,
  apply can_get_to_trans'' t₁ (move t₃ d s) t₃,
  split,
  { exact h₂ },
  { sorry }
end

-- any puzzle can be solved!!
-- when we prove this, we win forever ;)
theorem ultimate : ∀ (disks : ℕ), game disks :=
begin
  intros disks,
  sorry
end

end hanoi


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.pow
! leanprover-community/mathlib commit 3e00d81bdcbf77c8188bbd18f5524ddc3ed8cac6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Order

/-! # `Nat.pow`

Results on the power operation on natural numbers.
-/

namespace Nat

/-! ### `pow` -/

-- Porting note: the next two lemmas have moved into `Std`.

-- The global `pow_le_pow_of_le_left` needs an extra hypothesis `0 ≤ x`.
#align nat.pow_le_pow_of_le_left Nat.pow_le_pow_of_le_left
#align nat.pow_le_pow_of_le_right Nat.pow_le_pow_of_le_right

theorem pow_lt_pow_of_lt_left {x y : ℕ} (H : x < y) {i} (h : 0 < i) : x ^ i < y ^ i :=
  _root_.pow_lt_pow_of_lt_left H (zero_le _) h
#align nat.pow_lt_pow_of_lt_left Nat.pow_lt_pow_of_lt_left

theorem pow_lt_pow_of_lt_right {x : ℕ} (H : 1 < x) {i j : ℕ} (h : i < j) : x ^ i < x ^ j :=
  pow_lt_pow H h
#align nat.pow_lt_pow_of_lt_right Nat.pow_lt_pow_of_lt_right

theorem pow_lt_pow_succ {p : ℕ} (h : 1 < p) (n : ℕ) : p ^ n < p ^ (n + 1) :=
  pow_lt_pow_of_lt_right h n.lt_succ_self
#align nat.pow_lt_pow_succ Nat.pow_lt_pow_succ

theorem le_self_pow {n : ℕ} (hn : n ≠ 0) : ∀ m : ℕ, m ≤ m ^ n
| 0 => zero_le _
| (_ + 1) => _root_.le_self_pow (le_add_left _ _) hn
#align nat.le_self_pow Nat.le_self_pow

theorem lt_pow_self {p : ℕ} (h : 1 < p) : ∀ n : ℕ, n < p ^ n
  | 0 => by simp [zero_lt_one]
  | n + 1 =>
    calc
      n + 1 < p ^ n + 1 := Nat.add_lt_add_right (lt_pow_self h _) _
      _ ≤ p ^ (n + 1) := pow_lt_pow_succ h _

#align nat.lt_pow_self Nat.lt_pow_self

theorem lt_two_pow (n : ℕ) : n < 2 ^ n :=
  lt_pow_self (by decide) n
#align nat.lt_two_pow Nat.lt_two_pow

theorem one_le_pow (n m : ℕ) (h : 0 < m) : 1 ≤ m ^ n := by
  rw [← one_pow n]
  exact Nat.pow_le_pow_of_le_left h n
#align nat.one_le_pow Nat.one_le_pow

theorem one_le_pow' (n m : ℕ) : 1 ≤ (m + 1) ^ n :=
  one_le_pow n (m + 1) (succ_pos m)
#align nat.one_le_pow' Nat.one_le_pow'

theorem one_le_two_pow (n : ℕ) : 1 ≤ 2 ^ n :=
  one_le_pow n 2 (by decide)
#align nat.one_le_two_pow Nat.one_le_two_pow

theorem one_lt_pow' (n m : ℕ) : 1 < (m + 2) ^ (n + 1) :=
  one_lt_pow (n + 1) (m + 2) (succ_pos n) (Nat.lt_of_sub_eq_succ rfl)
#align nat.one_lt_pow' Nat.one_lt_pow'

@[simp]
theorem one_lt_pow_iff {k n : ℕ} (h : 0 ≠ k) : 1 < n ^ k ↔ 1 < n := by
  rcases n with (rfl | n)
  · cases k <;> simp [zero_pow_eq]
  rcases n with (rfl | n)
  · rw [← Nat.one_eq_succ_zero, one_pow]
  refine' ⟨fun _ => one_lt_succ_succ n, fun _ => _⟩
  induction' k with k hk
  · exact absurd rfl h
  rcases k with (rfl | k)
  · simp [← Nat.one_eq_succ_zero]
  rw [pow_succ']
  exact one_lt_mul (one_lt_succ_succ _).le (hk (succ_ne_zero k).symm)
#align nat.one_lt_pow_iff Nat.one_lt_pow_iff

theorem one_lt_two_pow (n : ℕ) (h₀ : 0 < n) : 1 < 2 ^ n :=
  one_lt_pow n 2 h₀ (by decide)
#align nat.one_lt_two_pow Nat.one_lt_two_pow

theorem one_lt_two_pow' (n : ℕ) : 1 < 2 ^ (n + 1) :=
  one_lt_pow (n + 1) 2 (succ_pos n) (by decide)
#align nat.one_lt_two_pow' Nat.one_lt_two_pow'

theorem pow_right_strictMono {x : ℕ} (k : 2 ≤ x) : StrictMono fun n : ℕ => x ^ n := fun _ _ =>
  pow_lt_pow_of_lt_right k
#align nat.pow_right_strict_mono Nat.pow_right_strictMono

theorem pow_le_iff_le_right {x m n : ℕ} (k : 2 ≤ x) : x ^ m ≤ x ^ n ↔ m ≤ n :=
  StrictMono.le_iff_le (pow_right_strictMono k)
#align nat.pow_le_iff_le_right Nat.pow_le_iff_le_right

theorem pow_lt_iff_lt_right {x m n : ℕ} (k : 2 ≤ x) : x ^ m < x ^ n ↔ m < n :=
  StrictMono.lt_iff_lt (pow_right_strictMono k)
#align nat.pow_lt_iff_lt_right Nat.pow_lt_iff_lt_right

theorem pow_right_injective {x : ℕ} (k : 2 ≤ x) : Function.Injective fun n : ℕ => x ^ n :=
  StrictMono.injective (pow_right_strictMono k)
#align nat.pow_right_injective Nat.pow_right_injective

theorem pow_left_strictMono {m : ℕ} (k : 1 ≤ m) : StrictMono fun x : ℕ => x ^ m := fun _ _ h =>
  pow_lt_pow_of_lt_left h k
#align nat.pow_left_strict_mono Nat.pow_left_strictMono

theorem mul_lt_mul_pow_succ {n a q : ℕ} (a0 : 0 < a) (q1 : 1 < q) : n * q < a * q ^ (n + 1) := by
  rw [pow_succ, ← mul_assoc, mul_lt_mul_right (zero_lt_one.trans q1)]
  exact lt_mul_of_one_le_of_lt (Nat.succ_le_iff.mpr a0) (Nat.lt_pow_self q1 n)
#align nat.mul_lt_mul_pow_succ Nat.mul_lt_mul_pow_succ

end Nat

theorem StrictMono.nat_pow {n : ℕ} (hn : 1 ≤ n) {f : ℕ → ℕ} (hf : StrictMono f) :
    StrictMono fun m => f m ^ n :=
  (Nat.pow_left_strictMono hn).comp hf
#align strict_mono.nat_pow StrictMono.nat_pow

namespace Nat

theorem pow_le_iff_le_left {m x y : ℕ} (k : 1 ≤ m) : x ^ m ≤ y ^ m ↔ x ≤ y :=
  StrictMono.le_iff_le (pow_left_strictMono k)
#align nat.pow_le_iff_le_left Nat.pow_le_iff_le_left

theorem pow_lt_iff_lt_left {m x y : ℕ} (k : 1 ≤ m) : x ^ m < y ^ m ↔ x < y :=
  StrictMono.lt_iff_lt (pow_left_strictMono k)
#align nat.pow_lt_iff_lt_left Nat.pow_lt_iff_lt_left

theorem pow_left_injective {m : ℕ} (k : 1 ≤ m) : Function.Injective fun x : ℕ => x ^ m :=
  StrictMono.injective (pow_left_strictMono k)
#align nat.pow_left_injective Nat.pow_left_injective

theorem sq_sub_sq (a b : ℕ) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := by
  rw [sq, sq]
  exact Nat.mul_self_sub_mul_self_eq a b
#align nat.sq_sub_sq Nat.sq_sub_sq

alias sq_sub_sq ← pow_two_sub_pow_two
#align nat.pow_two_sub_pow_two Nat.pow_two_sub_pow_two

/-! ### `pow` and `mod` / `dvd` -/

theorem pow_mod (a b n : ℕ) : a ^ b % n = (a % n) ^ b % n := by
  induction' b with b ih
  rfl; simp [pow_succ, Nat.mul_mod, ih]
#align nat.pow_mod Nat.pow_mod

theorem mod_pow_succ {b : ℕ} (w m : ℕ) : m % b ^ succ w = b * (m / b % b ^ w) + m % b := by
  by_cases b_h : b = 0
  · simp [b_h, pow_succ]
  have b_pos := Nat.pos_of_ne_zero b_h
  induction m using Nat.strong_induction_on with
    | h p IH =>
      cases' lt_or_ge p (b ^ succ w) with h₁ h₁
      · -- base case: p < b^succ w
        have h₂ : p / b < b ^ w := by
          rw [div_lt_iff_lt_mul b_pos]
          simpa [pow_succ] using h₁
        rw [mod_eq_of_lt h₁, mod_eq_of_lt h₂]
        simp [div_add_mod]
      · -- step: p ≥ b^succ w
        -- Generate condition for induction hypothesis
        have h₂ : p - b ^ succ w < p :=
          tsub_lt_self ((pow_pos b_pos _).trans_le h₁) (pow_pos b_pos _)
        -- Apply induction
        rw [mod_eq_sub_mod h₁, IH _ h₂]
        -- Normalize goal and h1
        simp only [pow_succ']
        simp only [GE.ge, pow_succ'] at h₁
        -- Pull subtraction outside mod and div
        rw [sub_mul_mod h₁, sub_mul_div _ _ _ h₁]
        -- Cancel subtraction inside mod b^w
        have p_b_ge : b ^ w ≤ p / b := by
          rw [le_div_iff_mul_le b_pos, mul_comm]
          exact h₁
        rw [Eq.symm (mod_eq_sub_mod p_b_ge)]
#align nat.mod_pow_succ Nat.mod_pow_succ

theorem pow_dvd_pow_iff_pow_le_pow {k l : ℕ} : ∀ {x : ℕ} (_ : 0 < x), x ^ k ∣ x ^ l ↔ x ^ k ≤ x ^ l
  | x + 1, w => by
    constructor
    · intro a
      exact le_of_dvd (pow_pos (succ_pos x) l) a
    · intro a
      cases' x with x
      · simp
      · have le := (pow_le_iff_le_right (Nat.le_add_left _ _)).mp a
        use (x + 2) ^ (l - k)
        rw [← pow_add, add_comm k, tsub_add_cancel_of_le le]
#align nat.pow_dvd_pow_iff_pow_le_pow Nat.pow_dvd_pow_iff_pow_le_pow

/-- If `1 < x`, then `x^k` divides `x^l` if and only if `k` is at most `l`. -/
theorem pow_dvd_pow_iff_le_right {x k l : ℕ} (w : 1 < x) : x ^ k ∣ x ^ l ↔ k ≤ l := by
  rw [pow_dvd_pow_iff_pow_le_pow (lt_of_succ_lt w), pow_le_iff_le_right w]
#align nat.pow_dvd_pow_iff_le_right Nat.pow_dvd_pow_iff_le_right

theorem pow_dvd_pow_iff_le_right' {b k l : ℕ} : (b + 2) ^ k ∣ (b + 2) ^ l ↔ k ≤ l :=
  pow_dvd_pow_iff_le_right (Nat.lt_of_sub_eq_succ rfl)
#align nat.pow_dvd_pow_iff_le_right' Nat.pow_dvd_pow_iff_le_right'

theorem not_pos_pow_dvd : ∀ {p k : ℕ} (_ : 1 < p) (_ : 1 < k), ¬p ^ k ∣ p
  | succ p, succ k, hp, hk, h =>
    have : succ p * succ p ^ k ∣ succ p * 1 := by simpa [pow_succ'] using h
    have : succ p ^ k ∣ 1 := Nat.dvd_of_mul_dvd_mul_left (succ_pos _) this
    have he : succ p ^ k = 1 := eq_one_of_dvd_one this
    have : k < succ p ^ k := lt_pow_self hp k
    have : k < 1 := by rwa [he] at this
    have : k = 0 := Nat.eq_zero_of_le_zero <| le_of_lt_succ this
    have : 1 < 1 := by rwa [this] at hk
    absurd this (by decide)
#align nat.not_pos_pow_dvd Nat.not_pos_pow_dvd

theorem pow_dvd_of_le_of_pow_dvd {p m n k : ℕ} (hmn : m ≤ n) (hdiv : p ^ n ∣ k) : p ^ m ∣ k :=
  (pow_dvd_pow _ hmn).trans hdiv
#align nat.pow_dvd_of_le_of_pow_dvd Nat.pow_dvd_of_le_of_pow_dvd

theorem dvd_of_pow_dvd {p k m : ℕ} (hk : 1 ≤ k) (hpk : p ^ k ∣ m) : p ∣ m := by
  rw [← pow_one p]; exact pow_dvd_of_le_of_pow_dvd hk hpk
#align nat.dvd_of_pow_dvd Nat.dvd_of_pow_dvd

theorem pow_div {x m n : ℕ} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ n = x ^ (m - n) := by
  rw [Nat.div_eq_iff_eq_mul_left (pow_pos hx n) (pow_dvd_pow _ h), pow_sub_mul_pow _ h]
#align nat.pow_div Nat.pow_div

theorem lt_of_pow_dvd_right {p i n : ℕ} (hn : n ≠ 0) (hp : 2 ≤ p) (h : p ^ i ∣ n) : i < n := by
  rw [← pow_lt_iff_lt_right hp]
  exact lt_of_le_of_lt (le_of_dvd hn.bot_lt h) (lt_pow_self (succ_le_iff.mp hp) n)
#align nat.lt_of_pow_dvd_right Nat.lt_of_pow_dvd_right

end Nat


import data.real.basic
import algebra.group.pi
import libs.tuto_lib

notation `|`x`|` := abs x

/-
In this file we manipulate the elementary definition of limits of
sequences of real numbers.
mathlib has a much more general definition of limits, but here
we want to practice using the logical operators and relations
covered in the previous files.

A sequence u is a function from ℕ to ℝ, hence Lean says
u : ℕ → ℝ
The definition we'll be using is:

-- Definition of « u tends to l »
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

Note the use of `∀ ε > 0, ...` which is an abbreviation of
`∀ ε, ε > 0 → ... `

In particular, a statement like `h : ∀ ε > 0, ...`
can be specialized to a given ε₀ by
  `specialize h ε₀ hε₀`
where hε₀ is a proof of ε₀ > 0.

Also recall that, wherever Lean expects some proof term, we can
start a tactic mode proof using the keyword `by` (followed by curly braces
if you need more than one tactic invocation).
For instance, if the local context contains:

δ : ℝ
δ_pos : δ > 0
h : ∀ ε > 0, ...

then we can specialize h to the real number δ/2 using:
  `specialize h (δ/2) (by linarith)`
where `by linarith` will provide the proof of `δ/2 > 0` expected by Lean.

We'll take this opportunity to use two new tactics:

`norm_num` will perform numerical normalization on the goal and `norm_num at h`
will do the same in assumption `h`. This will get rid of trivial calculations on numbers,
like replacing |l - l| by zero in the next exercise.

`congr'` will try to prove equalities between applications of functions by recursively
proving the arguments are the same.
For instance, if the goal is `f x + g y = f z + g t` then congr will replace it by
two goals: `x = z` and `y = t`.
You can limit the recursion depth by specifying a natural number after `congr'`.
For instance, in the above example, `congr' 1` will give new goals
`f x = f z` and `g y = g t`, which only inspect arguments of the addition and not deeper.
-/

variables (u v w : ℕ → ℝ) (l l' : ℝ)

-- If u is constant with value l then u tends to l
-- 0033
example : (∀ n, u n = l) → seq_limit u l :=
begin
  intros hct ε hε,
  use 0,
  intro n,
  rw hct,
  norm_num,
  linarith,
end

/- When dealing with absolute values, we'll use lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub_comm (x y : ℝ) : |x - y| = |y - x|

You should probably write them down on a sheet of paper that you keep at
hand since they are used in many exercises.
-/

-- Assume l > 0. Then u tends to l implies u n ≥ l/2 for large enough n
-- 0034
example (hl : l > 0) : seq_limit u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  intro h,
  specialize h (l/2) (by linarith),
  cases h with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_le at hN,
  linarith, -- It seems that it is not so knowledgeable about absolute values
end

/-
When dealing with max, you can use

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

You should probably add them to the sheet of paper where you wrote
the `abs` lemmas since they are used in many exercises.

Let's see an example.
-/

-- If u tends to l and v tends l' then u+v tends to l+l'
example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁ hn₂,
  have fact₁ : |u n - l| ≤ ε/2,
    from hN₁ n (by linarith),  -- note the use of `from`.
                               -- This is an alias for `exact`,
                               -- but reads nicer in this context
  have fact₂ : |v n - l'| ≤ ε/2,
    from hN₂ n (by linarith),
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith,
end

/-
In the above proof, we used `have` to prepare facts for `linarith` consumption in the last line.
Since we have direct proof terms for them, we can feed them directly to `linarith` as in the next proof
of the same statement.
Another variation we introduce is rewriting using `ge_max_iff` and letting `linarith` handle the
conjunction, instead of creating two new assumptions.
-/

example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith [hN₁ n (by linarith), hN₂ n (by linarith)],
end

/- Let's do something similar: the squeezing theorem. -/
-- 0035
example (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε (by linarith) with N hN,
  cases hw ε (by linarith) with M hM,
  use max N M,
  intros n Hn,
  rw abs_le,
  specialize hN n,
  specialize hM n,
  rw abs_le at hN hM,
  rw ge_max_iff at Hn,
  split,
  { calc
    -ε  ≤ u n - l : by { exact (hN (by linarith)).left}
    ... ≤ v n - l : by { apply sub_le_sub, apply h, linarith},   },
  calc
  v n - l ≤ w n - l : by { apply sub_le_sub, apply h', linarith}
  ...     ≤ ε : by { exact (hM (by linarith)).right},
end

/- What about < ε? -/
-- 0036
example (u l) : seq_limit u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  split,
  { intros h,
    intros ε hε,
    rcases h (ε/2) (by linarith),
    use w,
    intros n hn,
    specialize h_1 n hn,
    linarith, },
  intros h,
  intros ε hε,
  rcases h ε hε,
  use w,
  intros n hn,
  specialize h_1 n hn,
  linarith,
end

/- In the next exercise, we'll use

eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y
-/

-- A sequence admits at most one limit
-- 0037
example : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros liml liml',
  apply eq_of_abs_sub_le_all,
  intros ε εpos,
  specialize liml (ε/2) (by linarith),
  specialize liml' (ε/2) (by linarith),
  cases liml with N hN,
  cases liml' with N' hN',
  specialize hN (max N N') (by linarith [le_max_left N N']),
  specialize hN' (max N N') (by linarith [le_max_right N N']),
  calc
  |l - l'| = |l - u (max N N') + (u (max N N') - l')| : by norm_num -- note associativity!
  ...      ≤ |u (max N N') - l| + |u (max N N') - l'| : by {rw abs_sub_comm, apply abs_add}
  ...      ≤ (ε/2) + (ε/2) : by {apply add_le_add, exact hN, linarith,}
    -- `linarith` would not figure out the `exact hN`.
    -- The same happens with `swap, exact hN'`
  ...      ≤ ε : by norm_num,
end

/-
Let's now practice deciphering definitions before proving.
-/

def non_decreasing (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- 0038
example (M : ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
seq_limit u M :=
begin
  intros ε ε_pos,
  cases h.right ε ε_pos with N hN,
  use N,
  intros n hn,
  have : 0 ≤ M - u n := by linarith [h.left n],
  calc
  |u n - M| = M - u n : by {rw abs_sub_comm, apply abs_of_nonneg this}
  ...       ≤ M - u N : by {linarith [h' N n (by linarith)]}
  ...       ≤ ε : by linarith,
end