/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers
import solutions.section02reals.sheet5 -- import a bunch of previous stuff

/-

# Harder questions

Here are some harder questions. Don't feel like you have
to do them. We've seen enough techniques to be able to do
all of these, but the truth is that we've seen a ton of stuff
in this course already, so probably you're not on top of all of
it yet, and furthermore we have not seen
some techniques which will enable you to cut corners. If you
want to become a real Lean expert then see how many of these
you can do. I will go through them all in a solutions video,
so if you like you can try some of them and then watch me
solving them.

Good luck!
-/

/-- If `a(n)` tends to `t` then `37 * a(n)` tends to `37 * t`-/
theorem tends_to_thirtyseven_mul (a : ℕ → ℝ) (t : ℝ) (h : tends_to a t) :
  tends_to (λ n, 37 * a n) (37 * t) :=
begin
  have : (0 : ℝ) < 37 := begin norm_num end, -- what is the nice way to switch to tactic mode?
  rw tends_to at *,
  intros ε hε,
  cases (h (ε/37) (div_pos hε this)) with k h,
  use k,
  intros n hn,
  rw [(mul_sub 37 (a n) t).symm, abs_mul, abs_of_pos this],
  exact (lt_div_iff' this).mp (h n hn),
end

/-- If `a(n)` tends to `t` and `c` is a positive constant then
`c * a(n)` tends to `c * t`. -/
theorem tends_to_pos_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tends_to a t)
  {c : ℝ} (hc : 0 < c) : tends_to (λ n, c * a n) (c * t) :=
begin
  rw tends_to at *,
  intros ε hε,
  cases (h (ε/c) (div_pos hε hc)) with k h,
  use k,
  intros n hn,
  rw [(mul_sub c (a n) t).symm, abs_mul, abs_of_pos hc, ←(lt_div_iff' hc)],
  exact h n hn,
end

/-- If `a(n)` tends to `t` and `c` is a negative constant then
`c * a(n)` tends to `c * t`. -/
theorem tends_to_neg_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tends_to a t)
  {c : ℝ} (hc : c < 0) : tends_to (λ n, c * a n) (c * t) :=
begin
  rw tends_to at *,
  intros ε hε,
  cases (h (- ε / c) (div_pos_of_neg_of_neg (neg_lt_zero.mpr hε) hc)) with k h,
  use k,
  intros n hn,
  rw [(mul_sub c (a n) t).symm, abs_mul, ←(lt_div_iff' (abs_pos_of_neg hc))],
  rw [(abs_of_neg hc), div_neg, ←neg_div],
  exact h n hn,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `c * a(n)` tends
to `c * t`. -/
theorem tends_to_const_mul {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tends_to a t) :
  tends_to (λ n, c * a n) (c * t) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `a(n) * c` tends
to `t * c`. -/
theorem tends_to_mul_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tends_to a t) :
  tends_to (λ n, a n * c) (t * c) :=
begin
  sorry
end

-- another proof of this result, showcasing some tactics
-- which I've not covered yet.
theorem tends_to_neg' {a : ℕ → ℝ} {t : ℝ} (ha : tends_to a t) :
  tends_to (λ n, - a n) (-t) :=
begin
  convert tends_to_const_mul (-1) ha, -- read about the `convert` tactic in the course notes!
  { ext, simp }, -- ext is a generic extensionality tactic. Here it's being
                 -- used to deduce that two functions are the same if they take
                 -- the same values everywhere
  { simp },
end

/-- If `a(n)-b(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)` tends to `t + u`. -/
theorem tends_to_of_tends_to_sub {a b : ℕ → ℝ} {t u : ℝ}
  (h1 : tends_to (λ n, a n - b n) t) (h2 : tends_to b u) :
  tends_to a (t+u) :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` then `a(n)-t` tends to `0`. -/
theorem tends_to_sub_lim {a : ℕ → ℝ} {t : ℝ}
  (h : tends_to a t) : tends_to (λ n, a n - t) 0 :=
begin
  sorry,
end

/-- If `a(n)` and `b(n)` both tend to zero, then their product tends
to zero. -/
theorem tends_to_zero_mul_tends_to_zero
  {a b : ℕ → ℝ} (ha : tends_to a 0) (hb : tends_to b 0) :
  tends_to (λ n, a n * b n) 0 :=
begin
  sorry,
end

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)*b(n)` tends to `t*u`. -/
theorem tends_to_mul (a b : ℕ → ℝ) (t u : ℝ) (ha : tends_to a t)
  (hb : tends_to b u) : tends_to (λ n, a n * b n) (t * u) :=
begin
  sorry,
end

-- something we never used!
/-- A sequence has at most one limit. -/
theorem tends_to_unique (a : ℕ → ℝ) (s t : ℝ)
  (hs : tends_to a s) (ht : tends_to a t) : s = t :=
begin
  sorry,
end


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lu-Ming Zhang

! This file was ported from Lean 3 source module linear_algebra.matrix.symmetric
! leanprover-community/mathlib commit 55e2dfde0cff928ce5c70926a3f2c7dee3e2dd99
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Block

/-!
# Symmetric matrices

This file contains the definition and basic results about symmetric matrices.

## Main definition

 * `matrix.is_symm `: a matrix `A : matrix n n α` is "symmetric" if `Aᵀ = A`.

## Tags

symm, symmetric, matrix
-/

variable {α β n m R : Type _}

namespace Matrix

open Matrix

/-- A matrix `A : matrix n n α` is "symmetric" if `Aᵀ = A`. -/
def IsSymm (A : Matrix n n α) : Prop :=
  Aᵀ = A
#align matrix.is_symm Matrix.IsSymm

theorem IsSymm.eq {A : Matrix n n α} (h : A.IsSymm) : Aᵀ = A :=
  h
#align matrix.is_symm.eq Matrix.IsSymm.eq

/-- A version of `matrix.ext_iff` that unfolds the `matrix.transpose`. -/
theorem IsSymm.ext_iff {A : Matrix n n α} : A.IsSymm ↔ ∀ i j, A j i = A i j :=
  Matrix.ext_iff.symm
#align matrix.is_symm.ext_iff Matrix.IsSymm.ext_iff

/-- A version of `matrix.ext` that unfolds the `matrix.transpose`. -/
@[ext]
theorem IsSymm.ext {A : Matrix n n α} : (∀ i j, A j i = A i j) → A.IsSymm :=
  Matrix.ext
#align matrix.is_symm.ext Matrix.IsSymm.ext

theorem IsSymm.apply {A : Matrix n n α} (h : A.IsSymm) (i j : n) : A j i = A i j :=
  IsSymm.ext_iff.1 h i j
#align matrix.is_symm.apply Matrix.IsSymm.apply

theorem isSymm_mul_transpose_self [Fintype n] [CommSemiring α] (A : Matrix n n α) :
    (A ⬝ Aᵀ).IsSymm :=
  transpose_mul _ _
#align matrix.is_symm_mul_transpose_self Matrix.isSymm_mul_transpose_self

theorem isSymm_transpose_mul_self [Fintype n] [CommSemiring α] (A : Matrix n n α) :
    (Aᵀ ⬝ A).IsSymm :=
  transpose_mul _ _
#align matrix.is_symm_transpose_mul_self Matrix.isSymm_transpose_mul_self

theorem isSymm_add_transpose_self [AddCommSemigroup α] (A : Matrix n n α) : (A + Aᵀ).IsSymm :=
  add_comm _ _
#align matrix.is_symm_add_transpose_self Matrix.isSymm_add_transpose_self

theorem isSymm_transpose_add_self [AddCommSemigroup α] (A : Matrix n n α) : (Aᵀ + A).IsSymm :=
  add_comm _ _
#align matrix.is_symm_transpose_add_self Matrix.isSymm_transpose_add_self

@[simp]
theorem isSymm_zero [Zero α] : (0 : Matrix n n α).IsSymm :=
  transpose_zero
#align matrix.is_symm_zero Matrix.isSymm_zero

@[simp]
theorem isSymm_one [DecidableEq n] [Zero α] [One α] : (1 : Matrix n n α).IsSymm :=
  transpose_one
#align matrix.is_symm_one Matrix.isSymm_one

@[simp]
theorem IsSymm.map {A : Matrix n n α} (h : A.IsSymm) (f : α → β) : (A.map f).IsSymm :=
  transpose_map.symm.trans (h.symm ▸ rfl)
#align matrix.is_symm.map Matrix.IsSymm.map

@[simp]
theorem IsSymm.transpose {A : Matrix n n α} (h : A.IsSymm) : Aᵀ.IsSymm :=
  congr_arg _ h
#align matrix.is_symm.transpose Matrix.IsSymm.transpose

@[simp]
theorem IsSymm.conjTranspose [Star α] {A : Matrix n n α} (h : A.IsSymm) : Aᴴ.IsSymm :=
  h.transpose.map _
#align matrix.is_symm.conj_transpose Matrix.IsSymm.conjTranspose

@[simp]
theorem IsSymm.neg [Neg α] {A : Matrix n n α} (h : A.IsSymm) : (-A).IsSymm :=
  (transpose_neg _).trans (congr_arg _ h)
#align matrix.is_symm.neg Matrix.IsSymm.neg

@[simp]
theorem IsSymm.add {A B : Matrix n n α} [Add α] (hA : A.IsSymm) (hB : B.IsSymm) : (A + B).IsSymm :=
  (transpose_add _ _).trans (hA.symm ▸ hB.symm ▸ rfl)
#align matrix.is_symm.add Matrix.IsSymm.add

@[simp]
theorem IsSymm.sub {A B : Matrix n n α} [Sub α] (hA : A.IsSymm) (hB : B.IsSymm) : (A - B).IsSymm :=
  (transpose_sub _ _).trans (hA.symm ▸ hB.symm ▸ rfl)
#align matrix.is_symm.sub Matrix.IsSymm.sub

@[simp]
theorem IsSymm.smul [SMul R α] {A : Matrix n n α} (h : A.IsSymm) (k : R) : (k • A).IsSymm :=
  (transpose_smul _ _).trans (congr_arg _ h)
#align matrix.is_symm.smul Matrix.IsSymm.smul

@[simp]
theorem IsSymm.submatrix {A : Matrix n n α} (h : A.IsSymm) (f : m → n) : (A.submatrix f f).IsSymm :=
  (transpose_submatrix _ _ _).trans (h.symm ▸ rfl)
#align matrix.is_symm.submatrix Matrix.IsSymm.submatrix

/-- The diagonal matrix `diagonal v` is symmetric. -/
@[simp]
theorem isSymm_diagonal [DecidableEq n] [Zero α] (v : n → α) : (diagonal v).IsSymm :=
  diagonal_transpose _
#align matrix.is_symm_diagonal Matrix.isSymm_diagonal

/-- A block matrix `A.from_blocks B C D` is symmetric,
    if `A` and `D` are symmetric and `Bᵀ = C`. -/
theorem IsSymm.fromBlocks {A : Matrix m m α} {B : Matrix m n α} {C : Matrix n m α}
    {D : Matrix n n α} (hA : A.IsSymm) (hBC : Bᵀ = C) (hD : D.IsSymm) :
    (A.fromBlocks B C D).IsSymm :=
  by
  have hCB : Cᵀ = B := by
    rw [← hBC]
    simp
  unfold Matrix.IsSymm
  rw [from_blocks_transpose]
  congr <;> assumption
#align matrix.is_symm.from_blocks Matrix.IsSymm.fromBlocks

/-- This is the `iff` version of `matrix.is_symm.from_blocks`. -/
theorem isSymm_fromBlocks_iff {A : Matrix m m α} {B : Matrix m n α} {C : Matrix n m α}
    {D : Matrix n n α} : (A.fromBlocks B C D).IsSymm ↔ A.IsSymm ∧ Bᵀ = C ∧ Cᵀ = B ∧ D.IsSymm :=
  ⟨fun h =>
    ⟨congr_arg toBlocks₁₁ h, congr_arg toBlocks₂₁ h, congr_arg toBlocks₁₂ h,
      congr_arg toBlocks₂₂ h⟩,
    fun ⟨hA, hBC, hCB, hD⟩ => IsSymm.fromBlocks hA hBC hD⟩
#align matrix.is_symm_from_blocks_iff Matrix.isSymm_fromBlocks_iff

end Matrix


constant ax : nat
noncomputable def test : nat → nat
| 0     := ax
| (n+1) := test n

---

constant f : nat → nat
noncomputable def test' : nat → nat
| 0     := ax
| (n+1) := f (test' n)

#reduce test' 0 -- ax
#reduce test' 1 -- f ax
#reduce test' 2 -- f (f ax)
#reduce test' 3 -- f (f (f ax))

constant h : ∀ n, ax = n → f (f ax) = n

example : test' 3 = f (f (f ax)) := rfl

set_option trace.simplify.rewrite true

lemma ex1 : test' 2 = ax :=
begin
  simp [test'],
-- [test'.equations._eqn_2]: test' 2 ==> f (test' 1)
-- [test'.equations._eqn_2]: test' 1 ==> f (test' 0)
-- [test'.equations._eqn_1]: test' 0 ==> ax
  apply (h ax),
  refl,
end

lemma ex2 : test' 2 = ax :=
begin
  simp [test', h ax],
-- [test'.equations._eqn_2]: test' 2 ==> f (test' 1)
-- [test'.equations._eqn_2]: test' 1 ==> f (test' 0)
-- [test'.equations._eqn_1]: test' 0 ==> ax
-- [eq_self_iff_true]: ax = ax ==> true
-- [[h ax]]: f (f ax) ==> ax
-- [eq_self_iff_true]: ax = ax ==> true
end

lemma ex3 : test' 3 = f ax :=
begin
  simp [test', h ax],
-- [test'.equations._eqn_2]: test' 3 ==> f (test' 2)
-- [test'.equations._eqn_2]: test' 2 ==> f (test' 1)
-- [test'.equations._eqn_2]: test' 1 ==> f (test' 0)
-- [test'.equations._eqn_1]: test' 0 ==> ax
-- [eq_self_iff_true]: ax = ax ==> true
-- [[h ax]]: f (f ax) ==> ax
-- [eq_self_iff_true]: f ax = f ax ==> true
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.function
import Mathlib.logic.function.iterate
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Fixed points of a self-map

In this file we define

* the predicate `is_fixed_pt f x := f x = x`;
* the set `fixed_points f` of fixed points of a self-map `f`.

We also prove some simple lemmas about `is_fixed_pt` and `∘`, `iterate`, and `semiconj`.

## Tags

fixed point
-/

namespace function

/-- A point `x` is a fixed point of `f : α → α` if `f x = x`. -/
def is_fixed_pt {α : Type u} (f : α → α) (x : α) :=
  f x = x

/-- Every point is a fixed point of `id`. -/
theorem is_fixed_pt_id {α : Type u} (x : α) : is_fixed_pt id x :=
  rfl

namespace is_fixed_pt

protected instance decidable {α : Type u} [h : DecidableEq α] {f : α → α} {x : α} : Decidable (is_fixed_pt f x) :=
  h (f x) x

/-- If `x` is a fixed point of `f`, then `f x = x`. This is useful, e.g., for `rw` or `simp`.-/
protected theorem eq {α : Type u} {f : α → α} {x : α} (hf : is_fixed_pt f x) : f x = x :=
  hf

/-- If `x` is a fixed point of `f` and `g`, then it is a fixed point of `f ∘ g`. -/
protected theorem comp {α : Type u} {f : α → α} {g : α → α} {x : α} (hf : is_fixed_pt f x) (hg : is_fixed_pt g x) : is_fixed_pt (f ∘ g) x :=
  Eq.trans (congr_arg f hg) hf

/-- If `x` is a fixed point of `f`, then it is a fixed point of `f^[n]`. -/
protected theorem iterate {α : Type u} {f : α → α} {x : α} (hf : is_fixed_pt f x) (n : ℕ) : is_fixed_pt (nat.iterate f n) x :=
  iterate_fixed hf n

/-- If `x` is a fixed point of `f ∘ g` and `g`, then it is a fixed point of `f`. -/
theorem left_of_comp {α : Type u} {f : α → α} {g : α → α} {x : α} (hfg : is_fixed_pt (f ∘ g) x) (hg : is_fixed_pt g x) : is_fixed_pt f x :=
  Eq.trans (congr_arg f (Eq.symm hg)) hfg

/-- If `x` is a fixed point of `f` and `g` is a left inverse of `f`, then `x` is a fixed
point of `g`. -/
theorem to_left_inverse {α : Type u} {f : α → α} {g : α → α} {x : α} (hf : is_fixed_pt f x) (h : left_inverse g f) : is_fixed_pt g x :=
  Eq.trans (congr_arg g (Eq.symm hf)) (h x)

/-- If `g` (semi)conjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
protected theorem map {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {x : α} (hx : is_fixed_pt fa x) {g : α → β} (h : semiconj g fa fb) : is_fixed_pt fb (g x) :=
  Eq.trans (Eq.symm (semiconj.eq h x)) (congr_arg g hx)

end is_fixed_pt

/-- The set of fixed points of a map `f : α → α`. -/
def fixed_points {α : Type u} (f : α → α) : set α :=
  set_of fun (x : α) => is_fixed_pt f x

protected instance fixed_points.decidable {α : Type u} [DecidableEq α] (f : α → α) (x : α) : Decidable (x ∈ fixed_points f) :=
  is_fixed_pt.decidable

@[simp] theorem mem_fixed_points {α : Type u} {f : α → α} {x : α} : x ∈ fixed_points f ↔ is_fixed_pt f x :=
  iff.rfl

/-- If `g` semiconjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
theorem semiconj.maps_to_fixed_pts {α : Type u} {β : Type v} {fa : α → α} {fb : β → β} {g : α → β} (h : semiconj g fa fb) : set.maps_to g (fixed_points fa) (fixed_points fb) :=
  fun (x : α) (hx : x ∈ fixed_points fa) => is_fixed_pt.map hx h

/-- Any two maps `f : α → β` and `g : β → α` are inverse of each other on the sets of fixed points
of `f ∘ g` and `g ∘ f`, respectively. -/
theorem inv_on_fixed_pts_comp {α : Type u} {β : Type v} (f : α → β) (g : β → α) : set.inv_on f g (fixed_points (f ∘ g)) (fixed_points (g ∘ f)) :=
  { left := fun (x : β) => id, right := fun (x : α) => id }

/-- Any map `f` sends fixed points of `g ∘ f` to fixed points of `f ∘ g`. -/
theorem maps_to_fixed_pts_comp {α : Type u} {β : Type v} (f : α → β) (g : β → α) : set.maps_to f (fixed_points (g ∘ f)) (fixed_points (f ∘ g)) :=
  fun (x : α) (hx : x ∈ fixed_points (g ∘ f)) => is_fixed_pt.map hx fun (x : α) => rfl

/-- Given two maps `f : α → β` and `g : β → α`, `g` is a bijective map between the fixed points
of `f ∘ g` and the fixed points of `g ∘ f`. The inverse map is `f`, see `inv_on_fixed_pts_comp`. -/
theorem bij_on_fixed_pts_comp {α : Type u} {β : Type v} (f : α → β) (g : β → α) : set.bij_on g (fixed_points (f ∘ g)) (fixed_points (g ∘ f)) :=
  set.inv_on.bij_on (inv_on_fixed_pts_comp f g) (maps_to_fixed_pts_comp g f) (maps_to_fixed_pts_comp f g)

/-- If self-maps `f` and `g` commute, then they are inverse of each other on the set of fixed points
of `f ∘ g`. This is a particular case of `function.inv_on_fixed_pts_comp`. -/
theorem commute.inv_on_fixed_pts_comp {α : Type u} {f : α → α} {g : α → α} (h : commute f g) : set.inv_on f g (fixed_points (f ∘ g)) (fixed_points (f ∘ g)) := sorry

/-- If self-maps `f` and `g` commute, then `f` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
theorem commute.left_bij_on_fixed_pts_comp {α : Type u} {f : α → α} {g : α → α} (h : commute f g) : set.bij_on f (fixed_points (f ∘ g)) (fixed_points (f ∘ g)) := sorry

/-- If self-maps `f` and `g` commute, then `g` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
theorem commute.right_bij_on_fixed_pts_comp {α : Type u} {f : α → α} {g : α → α} (h : commute f g) : set.bij_on g (fixed_points (f ∘ g)) (fixed_points (f ∘ g)) := sorry


-- Conmutadores_en_grupos.lean
-- Conmutadores en grupos.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 9-julio-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Importar la libería de táctica.
-- ---------------------------------------------------------------------

import tactic

-- ---------------------------------------------------------------------
-- Ejercicio. Import la libería básica de grupos.
-- ---------------------------------------------------------------------

import algebra.group.basic

-- ---------------------------------------------------------------------
-- Ejercicio. Habilitar la lógica clásica.
-- ---------------------------------------------------------------------

open classical

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar G y H como variables sobre grupos.
-- ---------------------------------------------------------------------

variables {G : Type*} [group G]
variables {H : Type*} [group H]

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar g y h como variables sobre elementos de G.
-- ---------------------------------------------------------------------

variables (g h : G)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    conmutador : G → G → G
-- tal que (gonmutador g h) es es conmutador de g y h; es decir,
--    g * h * g⁻¹ * h⁻¹
-- ---------------------------------------------------------------------

def conmutador
  (g : G)
  (h : G)
:= g * h * g⁻¹ * h⁻¹

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que las imágenes por homorfismo de conmutadores
-- son conmutadores.
-- ---------------------------------------------------------------------

lemma conmutador_hom
  (f : monoid_hom G H)
  : f (conmutador g h) = conmutador (f g) (f h) :=
begin
  calc f (conmutador g h)
       = f (g * h * g⁻¹ * h⁻¹)
       : by simp [conmutador]
  ... = f g * f h * f (g⁻¹) * f (h⁻¹)
      : by simp [mul_hom.map_mul]
  ... = f g * f h * (f g)⁻¹ * (f h)⁻¹
      : by {congr; simp only [monoid_hom.map_inv]}
  ... = conmutador (f g) (f h)
      : by simp [conmutador],
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    g^3 = g * g * g
-- ---------------------------------------------------------------------

lemma cubo :
  g^3 = g * g * g :=
by group

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el cubo de un conmutador se puede escribir
-- como el producto de dos conmutadores.
-- ---------------------------------------------------------------------

lemma cubo_de_conmutador
  (a : G) {A : G} {A_def : A = a⁻¹}
  (b : G) {B : G} {B_def : B = b⁻¹}
  : (conmutador a b)^3 =
    conmutador (a*b*A) (B*a*b*A^2) * conmutador (B*a*b) (b^2) :=
begin
  unfold conmutador,
  simp [cubo, A_def, B_def],
  group,
end

-- Referencia
-- ==========

-- Basado en commutator.lean de Clara Löh que se encuentra en
-- https://bit.ly/3uApeua


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach

! This file was ported from Lean 3 source module algebra.char_p.exp_char
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CharP.Basic
import Mathlib.Data.Nat.Prime

/-!
# Exponential characteristic

This file defines the exponential characteristic, which is defined to be 1 for a ring with
characteristic 0 and the same as the ordinary characteristic, if the ordinary characteristic is
prime. This concept is useful to simplify some theorem statements.
This file establishes a few basic results relating it to the (ordinary characteristic).
The definition is stated for a semiring, but the actual results are for nontrivial rings
(as far as exponential characteristic one is concerned), respectively a ring without zero-divisors
(for prime characteristic).

## Main results
- `ExpChar`: the definition of exponential characteristic
- `expChar_is_prime_or_one`: the exponential characteristic is a prime or one
- `char_eq_expChar_iff`: the characteristic equals the exponential characteristic iff the
  characteristic is prime

## Tags
exponential characteristic, characteristic
-/

universe u

variable (R : Type u)

section Semiring

variable [Semiring R]

/-- The definition of the exponential characteristic of a semiring. -/
class inductive ExpChar (R : Type u) [Semiring R] : ℕ → Prop
  | zero [CharZero R] : ExpChar R 1
  | prime {q : ℕ} (hprime : q.Prime) [hchar : CharP R q] : ExpChar R q
#align exp_char ExpChar
#align exp_char.prime ExpChar.prime

/-- The exponential characteristic is one if the characteristic is zero. -/
theorem expChar_one_of_char_zero (q : ℕ) [hp : CharP R 0] [hq : ExpChar R q] : q = 1 := by
  cases' hq with q hq_one hq_prime hq_hchar
  · rfl
  · exact False.elim (lt_irrefl _ ((hp.eq R hq_hchar).symm ▸ hq_prime : (0 : ℕ).Prime).pos)
#align exp_char_one_of_char_zero expChar_one_of_char_zero

/-- The characteristic equals the exponential characteristic iff the former is prime. -/
theorem char_eq_expChar_iff (p q : ℕ) [hp : CharP R p] [hq : ExpChar R q] : p = q ↔ p.Prime := by
  cases' hq with q hq_one hq_prime hq_hchar
  · rw [(CharP.eq R hp inferInstance : p = 0)]
    decide
  · exact ⟨fun hpq => hpq.symm ▸ hq_prime, fun _ => CharP.eq R hp hq_hchar⟩
#align char_eq_exp_char_iff char_eq_expChar_iff

section Nontrivial

variable [Nontrivial R]

/-- The exponential characteristic is one if the characteristic is zero. -/
theorem char_zero_of_expChar_one (p : ℕ) [hp : CharP R p] [hq : ExpChar R 1] : p = 0 := by
  cases hq
  · exact CharP.eq R hp inferInstance
  · exact False.elim (CharP.char_ne_one R 1 rfl)
#align char_zero_of_exp_char_one char_zero_of_expChar_one

-- see Note [lower instance priority]
/-- The characteristic is zero if the exponential characteristic is one. -/
instance (priority := 100) charZero_of_expChar_one' [hq : ExpChar R 1] : CharZero R := by
  cases hq
  · assumption
  · exact False.elim (CharP.char_ne_one R 1 rfl)
#align char_zero_of_exp_char_one' charZero_of_expChar_one'

/-- The exponential characteristic is one iff the characteristic is zero. -/
theorem expChar_one_iff_char_zero (p q : ℕ) [CharP R p] [ExpChar R q] : q = 1 ↔ p = 0 := by
  constructor
  · rintro rfl
    exact char_zero_of_expChar_one R p
  · rintro rfl
    exact expChar_one_of_char_zero R q
#align exp_char_one_iff_char_zero expChar_one_iff_char_zero

section NoZeroDivisors

variable [NoZeroDivisors R]

/-- A helper lemma: the characteristic is prime if it is non-zero. -/
theorem char_prime_of_ne_zero {p : ℕ} [hp : CharP R p] (p_ne_zero : p ≠ 0) : Nat.Prime p := by
  cases' CharP.char_is_prime_or_zero R p with h h
  · exact h
  · contradiction
#align char_prime_of_ne_zero char_prime_of_ne_zero

/-- The exponential characteristic is a prime number or one. -/
theorem expChar_is_prime_or_one (q : ℕ) [hq : ExpChar R q] : Nat.Prime q ∨ q = 1 := by
  cases hq
  case zero => exact .inr rfl
  case prime hp _ => exact .inl hp
#align exp_char_is_prime_or_one expChar_is_prime_or_one

end NoZeroDivisors

end Nontrivial

end Semiring


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

/-! # Multilinear maps over finite dimensional spaces

The main results are that multilinear maps over finitely-generated, free modules are
finitely-generated and free.

* `module.finite.multilinear_map`
* `module.free.multilinear_map`

We do not put this in `linear_algebra/multilinear_map/basic` to avoid making the imports too large
there.
-/

namespace multilinear_map

variables {ι R M₂ : Type*} {M₁ : ι → Type*}
variables [decidable_eq ι]
variables [fintype ι] [comm_ring R] [add_comm_group M₂] [module R M₂]
variables [Π i, add_comm_group (M₁ i)] [Π i, module R (M₁ i)]
variables [module.finite R M₂] [module.free R M₂]
variables [∀ i, module.finite R (M₁ i)] [∀ i, module.free R (M₁ i)]

-- the induction requires us to show both at once
private lemma free_and_finite :
  module.free R (multilinear_map R M₁ M₂) ∧ module.finite R (multilinear_map R M₁ M₂) :=
begin
  -- the `fin n` case is sufficient
  suffices : ∀ n (N : fin n → Type*) [Π i, add_comm_group (N i)],
    by exactI ∀ [Π i, module R (N i)],
    by exactI ∀ [∀ i, module.finite R (N i)] [∀ i, module.free R (N i)],
      module.free R (multilinear_map R N M₂) ∧ module.finite R (multilinear_map R N M₂),
  { casesI this _ (M₁ ∘ (fintype.equiv_fin ι).symm),
    have e := dom_dom_congr_linear_equiv' R M₁ M₂ (fintype.equiv_fin ι),
    exact ⟨module.free.of_equiv e.symm, module.finite.equiv e.symm⟩, },
  introsI n N _ _ _ _,
  unfreezingI { induction n with n ih },
  { exact ⟨module.free.of_equiv (const_linear_equiv_of_is_empty R N M₂),
           module.finite.equiv (const_linear_equiv_of_is_empty R N M₂)⟩ },
  { suffices :
      module.free R (N 0 →ₗ[R] multilinear_map R (λ (i : fin n), N i.succ) M₂) ∧
      module.finite R (N 0 →ₗ[R] multilinear_map R (λ (i : fin n), N i.succ) M₂),
    { casesI this,
      exact ⟨module.free.of_equiv (multilinear_curry_left_equiv R N M₂),
            module.finite.equiv (multilinear_curry_left_equiv R N M₂)⟩ },
    casesI ih (λ i, N i.succ),
    exact ⟨module.free.linear_map _ _ _, module.finite.linear_map _ _⟩ },
end

instance _root_.module.finite.multilinear_map : module.finite R (multilinear_map R M₁ M₂) :=
free_and_finite.2

instance _root_.module.free.multilinear_map : module.free R (multilinear_map R M₁ M₂) :=
free_and_finite.1

end multilinear_map


/-
Copyright (c) 2020 Yury Kudriashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudriashov, Yaël Dillies
-/
import analysis.convex.basic
import order.closure

/-!
# Convex hull

This file defines the convex hull of a set `s` in a module. `convex_hull 𝕜 s` is the smallest convex
set containing `s`. In order theory speak, this is a closure operator.

## Implementation notes

`convex_hull` is defined as a closure operator. This gives access to the `closure_operator` API
while the impact on writing code is minimal as `convex_hull 𝕜 s` is automatically elaborated as
`⇑(convex_hull 𝕜) s`.
-/

open set
open_locale pointwise

variables {𝕜 E F : Type*}

section convex_hull
section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables (𝕜) [add_comm_monoid E] [add_comm_monoid F] [module 𝕜 E] [module 𝕜 F]

/-- The convex hull of a set `s` is the minimal convex set that includes `s`. -/
def convex_hull : closure_operator (set E) :=
closure_operator.mk₃
  (λ s, ⋂ (t : set E) (hst : s ⊆ t) (ht : convex 𝕜 t), t)
  (convex 𝕜)
  (λ s, set.subset_Inter (λ t, set.subset_Inter $ λ hst, set.subset_Inter $ λ ht, hst))
  (λ s, convex_Inter $ λ t, convex_Inter $ λ ht, convex_Inter id)
  (λ s t hst ht, set.Inter_subset_of_subset t $ set.Inter_subset_of_subset hst $
  set.Inter_subset _ ht)

variables (s : set E)

lemma subset_convex_hull : s ⊆ convex_hull 𝕜 s := (convex_hull 𝕜).le_closure s

lemma convex_convex_hull : convex 𝕜 (convex_hull 𝕜 s) := closure_operator.closure_mem_mk₃ s

lemma convex_hull_eq_Inter : convex_hull 𝕜 s = ⋂ (t : set E) (hst : s ⊆ t) (ht : convex 𝕜 t), t :=
rfl

variables {𝕜 s} {t : set E} {x y : E}

lemma mem_convex_hull_iff : x ∈ convex_hull 𝕜 s ↔ ∀ t, s ⊆ t → convex 𝕜 t → x ∈ t :=
by simp_rw [convex_hull_eq_Inter, mem_Inter]

lemma convex_hull_min (hst : s ⊆ t) (ht : convex 𝕜 t) : convex_hull 𝕜 s ⊆ t :=
closure_operator.closure_le_mk₃_iff (show s ≤ t, from hst) ht

lemma convex.convex_hull_subset_iff (ht : convex 𝕜 t) : convex_hull 𝕜 s ⊆ t ↔ s ⊆ t :=
⟨(subset_convex_hull _ _).trans, λ h, convex_hull_min h ht⟩

@[mono] lemma convex_hull_mono (hst : s ⊆ t) : convex_hull 𝕜 s ⊆ convex_hull 𝕜 t :=
(convex_hull 𝕜).monotone hst

lemma convex.convex_hull_eq (hs : convex 𝕜 s) : convex_hull 𝕜 s = s :=
closure_operator.mem_mk₃_closed hs

@[simp] lemma convex_hull_univ : convex_hull 𝕜 (univ : set E) = univ :=
closure_operator.closure_top (convex_hull 𝕜)

@[simp] lemma convex_hull_empty : convex_hull 𝕜 (∅ : set E) = ∅ := convex_empty.convex_hull_eq

@[simp] lemma convex_hull_empty_iff : convex_hull 𝕜 s = ∅ ↔ s = ∅ :=
begin
  split,
  { intro h,
    rw [←set.subset_empty_iff, ←h],
    exact subset_convex_hull 𝕜 _ },
  { rintro rfl,
    exact convex_hull_empty }
end

@[simp] lemma convex_hull_nonempty_iff : (convex_hull 𝕜 s).nonempty ↔ s.nonempty :=
begin
  rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, ne.def],
  exact not_congr convex_hull_empty_iff,
end

alias convex_hull_nonempty_iff ↔ _ set.nonempty.convex_hull

attribute [protected] set.nonempty.convex_hull

lemma segment_subset_convex_hull (hx : x ∈ s) (hy : y ∈ s) : segment 𝕜 x y ⊆ convex_hull 𝕜 s :=
(convex_convex_hull _ _).segment_subset (subset_convex_hull _ _ hx) (subset_convex_hull _ _ hy)

@[simp] lemma convex_hull_singleton (x : E) : convex_hull 𝕜 ({x} : set E) = {x} :=
(convex_singleton x).convex_hull_eq

@[simp] lemma convex_hull_pair (x y : E) : convex_hull 𝕜 {x, y} = segment 𝕜 x y :=
begin
  refine (convex_hull_min _ $ convex_segment _ _).antisymm
    (segment_subset_convex_hull (mem_insert _ _) $ mem_insert_of_mem _ $ mem_singleton _),
  rw [insert_subset, singleton_subset_iff],
  exact ⟨left_mem_segment _ _ _, right_mem_segment _ _ _⟩,
end

lemma convex_hull_convex_hull_union_left (s t : set E) :
  convex_hull 𝕜 (convex_hull 𝕜 s ∪ t) = convex_hull 𝕜 (s ∪ t) :=
closure_operator.closure_sup_closure_left _ _ _

lemma convex_hull_convex_hull_union_right (s t : set E) :
  convex_hull 𝕜 (s ∪ convex_hull 𝕜 t) = convex_hull 𝕜 (s ∪ t) :=
closure_operator.closure_sup_closure_right _ _ _

lemma convex.convex_remove_iff_not_mem_convex_hull_remove {s : set E} (hs : convex 𝕜 s) (x : E) :
  convex 𝕜 (s \ {x}) ↔ x ∉ convex_hull 𝕜 (s \ {x}) :=
begin
  split,
  { rintro hsx hx,
    rw hsx.convex_hull_eq at hx,
    exact hx.2 (mem_singleton _) },
  rintro hx,
  suffices h : s \ {x} = convex_hull 𝕜 (s \ {x}), { convert convex_convex_hull 𝕜 _ },
  exact subset.antisymm (subset_convex_hull 𝕜 _) (λ y hy, ⟨convex_hull_min (diff_subset _ _) hs hy,
    by { rintro (rfl : y = x), exact hx hy }⟩),
end

lemma is_linear_map.convex_hull_image {f : E → F} (hf : is_linear_map 𝕜 f) (s : set E) :
  convex_hull 𝕜 (f '' s) = f '' convex_hull 𝕜 s :=
set.subset.antisymm (convex_hull_min (image_subset _ (subset_convex_hull 𝕜 s)) $
  (convex_convex_hull 𝕜 s).is_linear_image hf)
  (image_subset_iff.2 $ convex_hull_min
    (image_subset_iff.1 $ subset_convex_hull 𝕜 _)
    ((convex_convex_hull 𝕜 _).is_linear_preimage hf))

lemma linear_map.convex_hull_image (f : E →ₗ[𝕜] F) (s : set E) :
  convex_hull 𝕜 (f '' s) = f '' convex_hull 𝕜 s :=
f.is_linear.convex_hull_image s

end add_comm_monoid
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E]

lemma convex_hull_smul (a : 𝕜) (s : set E) : convex_hull 𝕜 (a • s) = a • convex_hull 𝕜 s :=
(linear_map.lsmul _ _ a).convex_hull_image _

end ordered_comm_semiring

section ordered_ring
variables [ordered_ring 𝕜]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] (s : set E)

lemma affine_map.image_convex_hull (f : E →ᵃ[𝕜] F) :
  f '' convex_hull 𝕜 s = convex_hull 𝕜 (f '' s) :=
begin
  apply set.subset.antisymm,
  { rw set.image_subset_iff,
    refine convex_hull_min _ ((convex_convex_hull 𝕜 (⇑f '' s)).affine_preimage f),
    rw ← set.image_subset_iff,
    exact subset_convex_hull 𝕜 (f '' s) },
  { exact convex_hull_min (set.image_subset _ (subset_convex_hull 𝕜 s))
    ((convex_convex_hull 𝕜 s).affine_image f) }
end

lemma convex_hull_subset_affine_span : convex_hull 𝕜 s ⊆ (affine_span 𝕜 s : set E) :=
convex_hull_min (subset_affine_span 𝕜 s) (affine_span 𝕜 s).convex

@[simp] lemma affine_span_convex_hull : affine_span 𝕜 (convex_hull 𝕜 s) = affine_span 𝕜 s :=
begin
  refine le_antisymm _ (affine_span_mono 𝕜 (subset_convex_hull 𝕜 s)),
  rw affine_span_le,
  exact convex_hull_subset_affine_span s,
end

lemma convex_hull_neg (s : set E) : convex_hull 𝕜 (-s) = -convex_hull 𝕜 s :=
by { simp_rw ←image_neg, exact (affine_map.image_convex_hull _ $ -1).symm }

end add_comm_group
end ordered_ring
end convex_hull


import tactic
import data.zmod.basic

/-

# Prove that 19 ∣ 2^(2^(6k+2)) + 3 for k = 0,1,2,...

This is the fifth question in Sierpinski's book "250 elementary problems
in number theory".

thoughts

if a(k)=2^(2^(6k+2))
then a(k+1)=2^(2^6*2^(6k+2))=a(k)^64

Note that 16^64 is 16 mod 19 according to a brute force calculation
and so all of the a(k) are 16 mod 19 and we're done

-/

lemma sixteen_pow_sixtyfour_mod_nineteen : (16 : zmod 19)^64 = 16 :=
begin
  refl,
end.

example (a b : zmod 19) : (a + b = 0) ↔ a = -b := add_eq_zero_iff_eq_neg
example (k : ℕ) : 19 ∣ 2^(2^(6*k+2))+3 :=
begin
  induction k with d hd,
  { refl },
  have h : 2 ^ 2 ^ (6 * d.succ + 2) = (2 ^ 2 ^ (6 * d + 2)) ^ 64,
  { ring_exp },
  rw [← zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.cast_add, add_eq_zero_iff_eq_neg] at hd ⊢,
  rw h,
  rw nat.cast_pow,
  rw hd,
  convert sixteen_pow_sixtyfour_mod_nineteen,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.complete_lattice
import Mathlib.dynamics.fixed_points.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Fixed point construction on complete lattices
-/

/-- Least fixed point of a monotone function -/
/-- Greatest fixed point of a monotone function -/
def lfp {α : Type u} [complete_lattice α] (f : α → α) : α :=
  Inf (set_of fun (a : α) => f a ≤ a)

def gfp {α : Type u} [complete_lattice α] (f : α → α) : α :=
  Sup (set_of fun (a : α) => a ≤ f a)

theorem lfp_le {α : Type u} [complete_lattice α] {f : α → α} {a : α} (h : f a ≤ a) : lfp f ≤ a :=
  Inf_le h

theorem le_lfp {α : Type u} [complete_lattice α] {f : α → α} {a : α} (h : ∀ (b : α), f b ≤ b → a ≤ b) : a ≤ lfp f :=
  le_Inf h

theorem lfp_eq {α : Type u} [complete_lattice α] {f : α → α} (m : monotone f) : lfp f = f (lfp f) :=
  (fun (this : f (lfp f) ≤ lfp f) => le_antisymm (lfp_le (m this)) this)
    (le_lfp fun (b : α) (h : f b ≤ b) => le_trans (m (lfp_le h)) h)

theorem lfp_induct {α : Type u} [complete_lattice α] {f : α → α} {p : α → Prop} (m : monotone f) (step : ∀ (a : α), p a → a ≤ lfp f → p (f a)) (sup : ∀ (s : set α), (∀ (a : α), a ∈ s → p a) → p (Sup s)) : p (lfp f) := sorry

theorem monotone_lfp {α : Type u} [complete_lattice α] : monotone lfp :=
  fun (f g : α → α) (this : f ≤ g) => le_lfp fun (a : α) (this_1 : g a ≤ a) => lfp_le (le_trans (this a) this_1)

theorem le_gfp {α : Type u} [complete_lattice α] {f : α → α} {a : α} (h : a ≤ f a) : a ≤ gfp f :=
  le_Sup h

theorem gfp_le {α : Type u} [complete_lattice α] {f : α → α} {a : α} (h : ∀ (b : α), b ≤ f b → b ≤ a) : gfp f ≤ a :=
  Sup_le h

theorem gfp_eq {α : Type u} [complete_lattice α] {f : α → α} (m : monotone f) : gfp f = f (gfp f) :=
  (fun (this : gfp f ≤ f (gfp f)) => le_antisymm this (le_gfp (m this)))
    (gfp_le fun (b : α) (h : b ≤ f b) => le_trans h (m (le_gfp h)))

theorem gfp_induct {α : Type u} [complete_lattice α] {f : α → α} {p : α → Prop} (m : monotone f) (step : ∀ (a : α), p a → gfp f ≤ a → p (f a)) (inf : ∀ (s : set α), (∀ (a : α), a ∈ s → p a) → p (Inf s)) : p (gfp f) := sorry

theorem monotone_gfp {α : Type u} [complete_lattice α] : monotone gfp :=
  fun (f g : α → α) (this : f ≤ g) => gfp_le fun (a : α) (this_1 : a ≤ f a) => le_gfp (le_trans this_1 (this a))

-- Rolling rule

theorem lfp_comp {α : Type u} {β : Type v} [complete_lattice α] [complete_lattice β] {f : β → α} {g : α → β} (m_f : monotone f) (m_g : monotone g) : lfp (f ∘ g) = f (lfp (g ∘ f)) := sorry

theorem gfp_comp {α : Type u} {β : Type v} [complete_lattice α] [complete_lattice β] {f : β → α} {g : α → β} (m_f : monotone f) (m_g : monotone g) : gfp (f ∘ g) = f (gfp (g ∘ f)) := sorry

-- Diagonal rule

theorem lfp_lfp {α : Type u} [complete_lattice α] {h : α → α → α} (m : ∀ {a b c d : α}, a ≤ b → c ≤ d → h a c ≤ h b d) : lfp (lfp ∘ h) = lfp fun (x : α) => h x x := sorry

theorem gfp_gfp {α : Type u} [complete_lattice α] {h : α → α → α} (m : ∀ {a b c d : α}, a ≤ b → c ≤ d → h a c ≤ h b d) : gfp (gfp ∘ h) = gfp fun (x : α) => h x x := sorry

/- The complete lattice of fixed points of a function f -/

namespace fixed_points

def prev {α : Type u} [complete_lattice α] (f : α → α) (x : α) : α :=
  gfp fun (z : α) => x ⊓ f z

def next {α : Type u} [complete_lattice α] (f : α → α) (x : α) : α :=
  lfp fun (z : α) => x ⊔ f z

theorem prev_le {α : Type u} [complete_lattice α] {f : α → α} {x : α} : prev f x ≤ x :=
  gfp_le fun (z : α) (hz : z ≤ x ⊓ f z) => le_trans hz inf_le_left

theorem prev_eq {α : Type u} [complete_lattice α] {f : α → α} (hf : monotone f) {a : α} (h : f a ≤ a) : prev f a = f (prev f a) := sorry

def prev_fixed {α : Type u} [complete_lattice α] {f : α → α} (hf : monotone f) (a : α) (h : f a ≤ a) : ↥(function.fixed_points f) :=
  { val := prev f a, property := sorry }

theorem next_le {α : Type u} [complete_lattice α] {f : α → α} {x : α} : x ≤ next f x :=
  le_lfp fun (z : α) (hz : x ⊔ f z ≤ z) => le_trans le_sup_left hz

theorem next_eq {α : Type u} [complete_lattice α] {f : α → α} (hf : monotone f) {a : α} (h : a ≤ f a) : next f a = f (next f a) := sorry

def next_fixed {α : Type u} [complete_lattice α] {f : α → α} (hf : monotone f) (a : α) (h : a ≤ f a) : ↥(function.fixed_points f) :=
  { val := next f a, property := sorry }

theorem sup_le_f_of_fixed_points {α : Type u} [complete_lattice α] (f : α → α) (hf : monotone f) (x : ↥(function.fixed_points f)) (y : ↥(function.fixed_points f)) : subtype.val x ⊔ subtype.val y ≤ f (subtype.val x ⊔ subtype.val y) := sorry

theorem f_le_inf_of_fixed_points {α : Type u} [complete_lattice α] (f : α → α) (hf : monotone f) (x : ↥(function.fixed_points f)) (y : ↥(function.fixed_points f)) : f (subtype.val x ⊓ subtype.val y) ≤ subtype.val x ⊓ subtype.val y := sorry

theorem Sup_le_f_of_fixed_points {α : Type u} [complete_lattice α] (f : α → α) (hf : monotone f) (A : set α) (HA : A ⊆ function.fixed_points f) : Sup A ≤ f (Sup A) :=
  Sup_le fun (x : α) (hxA : x ∈ A) => HA hxA ▸ hf (le_Sup hxA)

theorem f_le_Inf_of_fixed_points {α : Type u} [complete_lattice α] (f : α → α) (hf : monotone f) (A : set α) (HA : A ⊆ function.fixed_points f) : f (Inf A) ≤ Inf A :=
  le_Inf fun (x : α) (hxA : x ∈ A) => HA hxA ▸ hf (Inf_le hxA)

/-- The fixed points of `f` form a complete lattice.
This cannot be an instance, since it depends on the monotonicity of `f`. -/
protected def complete_lattice {α : Type u} [complete_lattice α] (f : α → α) (hf : monotone f) : complete_lattice ↥(function.fixed_points f) :=
  complete_lattice.mk
    (fun (x y : ↥(function.fixed_points f)) =>
      next_fixed hf (subtype.val x ⊔ subtype.val y) (sup_le_f_of_fixed_points f hf x y))
    (fun (x y : ↥(function.fixed_points f)) => subtype.val x ≤ subtype.val y)
    (bounded_lattice.lt._default fun (x y : ↥(function.fixed_points f)) => subtype.val x ≤ subtype.val y) sorry sorry
    sorry sorry sorry sorry
    (fun (x y : ↥(function.fixed_points f)) =>
      prev_fixed hf (subtype.val x ⊓ subtype.val y) (f_le_inf_of_fixed_points f hf x y))
    sorry sorry sorry (prev_fixed hf ⊤ sorry) sorry (next_fixed hf ⊥ sorry) sorry
    (fun (A : set ↥(function.fixed_points f)) => next_fixed hf (Sup (subtype.val '' A)) sorry)
    (fun (A : set ↥(function.fixed_points f)) => prev_fixed hf (Inf (subtype.val '' A)) sorry) sorry sorry sorry sorry


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

import algebra.group_power
import algebra.group_power.basic
import logic.function.iterate
import group_theory.perm.basic

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to (not yet defined) `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open function

variables {M : Type*} {N : Type*} {G : Type*} {H : Type*}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
lemma hom_coe_pow {F : Type*} [monoid F] (c : F → M → M) (h1 : c 1 = id)
  (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = (c f^[n])
| 0 := by { rw [pow_zero, h1], refl }
| (n + 1) := by rw [pow_succ, iterate_succ', hmul, hom_coe_pow]

namespace monoid_hom

section

variables [mul_one_class M] [mul_one_class N]

@[simp, to_additive]
theorem iterate_map_one (f : M →* M) (n : ℕ) : f^[n] 1 = 1 :=
iterate_fixed f.map_one n

@[simp, to_additive]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) :
  f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
semiconj₂.iterate f.map_mul n x y

end

variables [monoid M] [monoid N] [group G] [group H]

@[simp, to_additive]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) :
  f^[n] (x⁻¹) = (f^[n] x)⁻¹ :=
commute.iterate_left f.map_inv n x

theorem iterate_map_pow (f : M →* M) (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_pow x m) n a

theorem iterate_map_gpow (f : G →* G) (a) (n : ℕ) (m : ℤ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_gpow x m) n a

lemma coe_pow {M} [comm_monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

end monoid_hom

namespace add_monoid_hom

variables [add_monoid M] [add_monoid N] [add_group G] [add_group H]

@[simp]
theorem iterate_map_sub (f : G →+ G) (n : ℕ) (x y) :
  f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
semiconj₂.iterate f.map_sub n x y

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_pow x n m

theorem iterate_map_gsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_gpow x n m

end add_monoid_hom

namespace ring_hom

section semiring

variables {R : Type*} [semiring R] (f : R →+* R) (n : ℕ) (x y : R)

lemma coe_pow (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) f n

theorem iterate_map_one : f^[n] 1 = 1 := f.to_monoid_hom.iterate_map_one n

theorem iterate_map_zero : f^[n] 0 = 0 := f.to_add_monoid_hom.iterate_map_zero n

theorem iterate_map_add : f^[n] (x + y) = (f^[n] x) + (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_add n x y

theorem iterate_map_mul : f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
f.to_monoid_hom.iterate_map_mul n x y

theorem iterate_map_pow (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
f.to_monoid_hom.iterate_map_pow a n m

theorem iterate_map_smul (n m : ℕ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_smul n m x

end semiring

variables {R : Type*} [ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_sub n x y

theorem iterate_map_neg : f^[n] (-x) = -(f^[n] x) :=
f.to_add_monoid_hom.iterate_map_neg n x

theorem iterate_map_gsmul (n : ℕ) (m : ℤ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_gsmul n m x

end ring_hom

lemma equiv.perm.coe_pow {α : Type*} (f : equiv.perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
hom_coe_pow _ rfl (λ _ _, rfl) _ _

--what should be the namespace for this section?
section monoid

variables [monoid G] (a : G) (n : ℕ)

@[simp] lemma mul_left_iterate : ((*) a)^[n] = (*) (a^n) :=
nat.rec_on n (funext $ λ x, by simp) $ λ n ihn,
funext $ λ x, by simp [iterate_succ, ihn, pow_succ', mul_assoc]

@[simp] lemma mul_right_iterate : (* a)^[n] = (* a ^ n) :=
begin
  induction n with d hd,
  { simpa },
  { simp [← pow_succ, hd] }
end

lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
by simp [mul_right_iterate]

end monoid

section semigroup

variables [semigroup G] {a b c : G}

@[to_additive]
lemma semiconj_by.function_semiconj_mul_left (h : semiconj_by a b c) :
  function.semiconj ((*)a) ((*)b) ((*)c) :=
λ j, by rw [← mul_assoc, h.eq, mul_assoc]

@[to_additive]
lemma commute.function_commute_mul_left (h : commute a b) :
  function.commute ((*)a) ((*)b) :=
semiconj_by.function_semiconj_mul_left h

@[to_additive]
lemma semiconj_by.function_semiconj_mul_right_swap (h : semiconj_by a b c) :
  function.semiconj (*a) (*c) (*b) :=
λ j, by simp_rw [mul_assoc, ← h.eq]

@[to_additive]
lemma commute.function_commute_mul_right (h : commute a b) :
  function.commute (*a) (*b) :=
semiconj_by.function_semiconj_mul_right_swap h

end semigroup

--what should be the namespace for this section?
section add_monoid

variables [add_monoid M] (a : M) (n : ℕ)

@[simp] lemma add_left_iterate : ((+) a)^[n] = (+) (n • a) :=
@mul_left_iterate (multiplicative M) _ a n

@[simp] lemma add_right_iterate : (+ a)^[n] = (+ n • a) :=
begin
  induction n with d hd,
  { simp [zero_nsmul, id_def] },
  { simp [hd, add_assoc, succ_nsmul] }
end

lemma add_right_iterate_apply_zero : (+ a)^[n] 0 = n • a :=
by simp [add_right_iterate]

end add_monoid


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree.definitions

/-!
# Trailing degree of univariate polynomials

## Main definitions

* `trailing_degree p`: the multiplicity of `X` in the polynomial `p`
* `nat_trailing_degree`: a variant of `trailing_degree` that takes values in the natural numbers
* `trailing_coeff`: the coefficient at index `nat_trailing_degree p`

Converts most results about `degree`, `nat_degree` and `leading_coeff` to results about the bottom
end of a polynomial
-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open function polynomial finsupp finset
open_locale big_operators

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

section semiring
variables [semiring R] {p q r : polynomial R}

/-- `trailing_degree p` is the multiplicity of `x` in the polynomial `p`, i.e. the smallest
`X`-exponent in `p`.
`trailing_degree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears
in `p`, otherwise
`trailing_degree 0 = ⊤`. -/
def trailing_degree (p : polynomial R) : with_top ℕ := p.support.inf some

lemma trailing_degree_lt_wf : well_founded
(λp q : polynomial R, trailing_degree p < trailing_degree q) :=
inv_image.wf trailing_degree (with_top.well_founded_lt nat.lt_wf)

/-- `nat_trailing_degree p` forces `trailing_degree p` to `ℕ`, by defining
`nat_trailing_degree ⊤ = 0`. -/
def nat_trailing_degree (p : polynomial R) : ℕ := (trailing_degree p).get_or_else 0

/-- `trailing_coeff p` gives the coefficient of the smallest power of `X` in `p`-/
def trailing_coeff (p : polynomial R) : R := coeff p (nat_trailing_degree p)

/-- a polynomial is `monic_at` if its trailing coefficient is 1 -/
def trailing_monic (p : polynomial R) := trailing_coeff p = (1 : R)

lemma trailing_monic.def : trailing_monic p ↔ trailing_coeff p = 1 := iff.rfl

instance trailing_monic.decidable [decidable_eq R] : decidable (trailing_monic p) :=
by unfold trailing_monic; apply_instance

@[simp] lemma trailing_monic.trailing_coeff {p : polynomial R} (hp : p.trailing_monic) :
  trailing_coeff p = 1 := hp

@[simp] lemma trailing_degree_zero : trailing_degree (0 : polynomial R) = ⊤ := rfl

@[simp] lemma nat_trailing_degree_zero : nat_trailing_degree (0 : polynomial R) = 0 := rfl

lemma trailing_degree_eq_top : trailing_degree p = ⊤ ↔ p = 0 :=
⟨λ h, by rw [trailing_degree, ← min_eq_inf_with_top] at h;
  exact support_eq_empty.1 (min_eq_none.1 h),
λ h, h.symm ▸ rfl⟩

lemma trailing_degree_eq_nat_trailing_degree (hp : p ≠ 0) :
  trailing_degree p = (nat_trailing_degree p : with_top ℕ) :=
let ⟨n, hn⟩ :=
  not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt trailing_degree_eq_top.1 hp)) in
have hn : trailing_degree p = some n := not_not.1 hn,
by rw [nat_trailing_degree, hn]; refl

lemma trailing_degree_eq_iff_nat_trailing_degree_eq {p : polynomial R} {n : ℕ} (hp : p ≠ 0) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
by rw [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_eq_coe]

lemma trailing_degree_eq_iff_nat_trailing_degree_eq_of_pos {p : polynomial R} {n : ℕ} (hn : 0 < n) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
begin
  split,
  { intro H, rwa ← trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw trailing_degree_zero at H, exact option.no_confusion H },
  { intro H, rwa trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw nat_trailing_degree_zero at H, rw H at hn, exact lt_irrefl _ hn }
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq_some {p : polynomial R} {n : ℕ}
  (h : trailing_degree p = n) : nat_trailing_degree p = n :=
have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h,
option.some_inj.1 $ show (nat_trailing_degree p : with_top ℕ) = n,
  by rwa [← trailing_degree_eq_nat_trailing_degree hp0]

@[simp] lemma nat_trailing_degree_le_trailing_degree :
  ↑(nat_trailing_degree p) ≤ trailing_degree p :=
begin
  by_cases hp : p = 0, { rw hp, exact le_top },
  rw [trailing_degree_eq_nat_trailing_degree hp],
  exact le_refl _
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq [semiring S] {q : polynomial S}
  (h : trailing_degree p = trailing_degree q) :
nat_trailing_degree p = nat_trailing_degree q :=
by unfold nat_trailing_degree; rw h

lemma le_trailing_degree_of_ne_zero (h : coeff p n ≠ 0) : trailing_degree p ≤ n :=
show @has_le.le (with_top ℕ) _ (p.support.inf some : with_top ℕ) (some n : with_top ℕ),
from finset.inf_le (finsupp.mem_support_iff.2 h)

lemma nat_trailing_degree_le_of_ne_zero (h : coeff p n ≠ 0) : nat_trailing_degree p ≤ n :=
begin
  rw [← with_top.coe_le_coe, ← trailing_degree_eq_nat_trailing_degree],
  { exact le_trailing_degree_of_ne_zero h, },
  { assume h, subst h, exact h rfl }
end

lemma trailing_degree_le_trailing_degree (h : coeff q (nat_trailing_degree p) ≠ 0) :
  trailing_degree q ≤ trailing_degree p :=
begin
  by_cases hp : p = 0,
  { rw hp, exact le_top },
  { rw trailing_degree_eq_nat_trailing_degree hp, exact le_trailing_degree_of_ne_zero h }
end

lemma trailing_degree_ne_of_nat_trailing_degree_ne {n : ℕ} :
  p.nat_trailing_degree ≠ n → trailing_degree p ≠ n :=
mt $ λ h, by rw [nat_trailing_degree, h, option.get_or_else_coe]

theorem nat_trailing_degree_le_of_trailing_degree_le {n : ℕ} {hp : p ≠ 0}
  (H : (n : with_top ℕ) ≤ trailing_degree p) : n ≤ nat_trailing_degree p :=
begin
  rw trailing_degree_eq_nat_trailing_degree hp at H,
  exact with_top.coe_le_coe.mp H,
end

@[simp] lemma trailing_degree_monomial (ha : a ≠ 0) : trailing_degree (monomial n a) = n :=
by rw [trailing_degree, support_monomial _ _ ha, inf_singleton, with_top.some_eq_coe]

lemma nat_trailing_degree_monomial (ha : a ≠ 0) : nat_trailing_degree (monomial n a) = n :=
by rw [nat_trailing_degree, trailing_degree_monomial ha]; refl

lemma nat_trailing_degree_monomial_le : nat_trailing_degree (monomial n a) ≤ n :=
if ha : a = 0 then by simp [ha] else (nat_trailing_degree_monomial ha).le

lemma le_trailing_degree_monomial : ↑n ≤ trailing_degree (monomial n a) :=
if ha : a = 0 then by simp [ha] else (trailing_degree_monomial ha).ge

@[simp] lemma trailing_degree_C (ha : a ≠ 0) : trailing_degree (C a) = (0 : with_top ℕ) :=
trailing_degree_monomial ha

lemma le_trailing_degree_C : (0 : with_top ℕ) ≤ trailing_degree (C a) :=
le_trailing_degree_monomial

lemma trailing_degree_one_le : (0 : with_top ℕ) ≤ trailing_degree (1 : polynomial R) :=
by rw [← C_1]; exact le_trailing_degree_C

@[simp] lemma nat_trailing_degree_C (a : R) : nat_trailing_degree (C a) = 0 :=
nonpos_iff_eq_zero.1 nat_trailing_degree_monomial_le

@[simp] lemma nat_trailing_degree_one : nat_trailing_degree (1 : polynomial R) = 0 :=
nat_trailing_degree_C 1

@[simp] lemma nat_trailing_degree_nat_cast (n : ℕ) : nat_trailing_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_nat_cast, nat_trailing_degree_C]

@[simp] lemma trailing_degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) :
  trailing_degree (C a * X ^ n) = n :=
by rw [C_mul_X_pow_eq_monomial, trailing_degree_monomial ha]

lemma le_trailing_degree_C_mul_X_pow (n : ℕ) (a : R) :
  (n : with_top ℕ) ≤ trailing_degree (C a * X ^ n) :=
by { rw C_mul_X_pow_eq_monomial, exact le_trailing_degree_monomial }

lemma coeff_eq_zero_of_trailing_degree_lt (h : (n : with_top ℕ) < trailing_degree p) :
  coeff p n = 0 :=
not_not.1 (mt le_trailing_degree_of_ne_zero (not_le_of_gt h))

lemma coeff_eq_zero_of_lt_nat_trailing_degree {p : polynomial R} {n : ℕ}
  (h : n < p.nat_trailing_degree) :
  p.coeff n = 0 :=
begin
  apply coeff_eq_zero_of_trailing_degree_lt,
  by_cases hp : p = 0,
  { subst hp, exact with_top.coe_lt_top n, },
  { rwa [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_lt_coe] },
end

@[simp] lemma coeff_nat_trailing_degree_pred_eq_zero {p : polynomial R}
  {hp : (0 : with_top ℕ) < nat_trailing_degree p} : p.coeff (p.nat_trailing_degree - 1) = 0 :=
coeff_eq_zero_of_lt_nat_trailing_degree $ nat.sub_lt
  ((with_top.zero_lt_coe (nat_trailing_degree p)).mp hp) nat.one_pos

theorem le_trailing_degree_X_pow (n : ℕ) :
  (n : with_top ℕ) ≤ trailing_degree (X^n : polynomial R) :=
by simpa only [C_1, one_mul] using le_trailing_degree_C_mul_X_pow n (1:R)

theorem le_trailing_degree_X : (1 : with_top ℕ) ≤ trailing_degree (X : polynomial R) :=
le_trailing_degree_monomial

lemma nat_trailing_degree_X_le : (X : polynomial R).nat_trailing_degree ≤ 1 :=
nat_trailing_degree_monomial_le

@[simp] lemma trailing_coeff_eq_zero : trailing_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction $ λ hp, mt mem_support_iff.1
  (not_not.2 h) (mem_of_min (trailing_degree_eq_nat_trailing_degree hp)),
λ h, h.symm ▸ leading_coeff_zero⟩

lemma trailing_coeff_nonzero_iff_nonzero : trailing_coeff p ≠ 0 ↔ p ≠ 0 :=
not_congr trailing_coeff_eq_zero

lemma nat_trailing_degree_mem_support_of_nonzero : p ≠ 0 → nat_trailing_degree p ∈ p.support :=
(mem_support_iff.mpr ∘ trailing_coeff_nonzero_iff_nonzero.mpr)

lemma nat_trailing_degree_le_of_mem_supp (a : ℕ) :
  a ∈ p.support → nat_trailing_degree p ≤ a:=
nat_trailing_degree_le_of_ne_zero ∘ mem_support_iff.mp

lemma nat_trailing_degree_eq_support_min' (h : p ≠ 0) :
  nat_trailing_degree p = p.support.min' (nonempty_support_iff.mpr h) :=
begin
  apply le_antisymm,
  { apply le_min',
    intros y hy,
    exact nat_trailing_degree_le_of_mem_supp y hy },
  { apply finset.min'_le,
    exact mem_support_iff.mpr (trailing_coeff_nonzero_iff_nonzero.mpr h), },
end

lemma nat_trailing_degree_le_nat_degree (p : polynomial R) :
  p.nat_trailing_degree ≤ p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, nat_degree_zero, nat_trailing_degree_zero] },
  { exact le_nat_degree_of_ne_zero (mt trailing_coeff_eq_zero.mp hp) },
end

lemma nat_trailing_degree_mul_X_pow {p : polynomial R} (hp : p ≠ 0) (n : ℕ) :
  (p * X ^ n).nat_trailing_degree = p.nat_trailing_degree + n :=
begin
  apply le_antisymm,
  { refine nat_trailing_degree_le_of_ne_zero (λ h, mt trailing_coeff_eq_zero.mp hp _),
    rwa [trailing_coeff, ←coeff_mul_X_pow] },
  { rw [nat_trailing_degree_eq_support_min' (λ h, hp (mul_X_pow_eq_zero h)), finset.le_min'_iff],
    intros y hy,
    have key : n ≤ y,
    { rw [mem_support_iff, coeff_mul_X_pow'] at hy,
      exact by_contra (λ h, hy (if_neg h)) },
    rw [mem_support_iff, coeff_mul_X_pow', if_pos key] at hy,
    exact (nat.add_le_to_le_sub _ key).mpr (nat_trailing_degree_le_of_ne_zero hy) },
end

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma trailing_degree_one : trailing_degree (1 : polynomial R) = (0 : with_top ℕ) :=
trailing_degree_C one_ne_zero

@[simp] lemma trailing_degree_X : trailing_degree (X : polynomial R) = 1 :=
trailing_degree_monomial one_ne_zero

@[simp] lemma nat_trailing_degree_X : (X : polynomial R).nat_trailing_degree = 1 :=
nat_trailing_degree_monomial one_ne_zero

end nonzero_semiring

section ring
variables [ring R]

@[simp] lemma trailing_degree_neg (p : polynomial R) : trailing_degree (-p) = trailing_degree p :=
by unfold trailing_degree; rw support_neg

@[simp] lemma nat_trailing_degree_neg (p : polynomial R) :
  nat_trailing_degree (-p) = nat_trailing_degree p :=
by simp [nat_trailing_degree]

@[simp] lemma nat_trailing_degree_int_cast (n : ℤ) : nat_trailing_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_int_cast, nat_trailing_degree_C]

end ring

section semiring
variables [semiring R]

/-- The second-lowest coefficient, or 0 for constants -/
def next_coeff_up (p : polynomial R) : R :=
if p.nat_trailing_degree = 0 then 0 else p.coeff (p.nat_trailing_degree + 1)

@[simp]
lemma next_coeff_up_C_eq_zero (c : R) :
  next_coeff_up (C c) = 0 := by { rw next_coeff_up, simp }

lemma next_coeff_up_of_pos_nat_trailing_degree (p : polynomial R) (hp : 0 < p.nat_trailing_degree) :
  next_coeff_up p = p.coeff (p.nat_trailing_degree + 1) :=
by { rw [next_coeff_up, if_neg], contrapose! hp, simpa }

end semiring

section semiring
variables [semiring R] {p q : polynomial R} {ι : Type*}

lemma coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt
  (h : trailing_degree p < trailing_degree q) :
  coeff q (nat_trailing_degree p) = 0 :=
coeff_eq_zero_of_trailing_degree_lt $ nat_trailing_degree_le_trailing_degree.trans_lt h

lemma ne_zero_of_trailing_degree_lt {n : with_top ℕ} (h : trailing_degree p < n) : p ≠ 0 :=
λ h₀, h.not_le (by simp [h₀])

end semiring
end polynomial


/-
Copyright (c) 2021 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck
-/
import linear_algebra.general_linear_group
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.matrix.special_linear_group

/-!
# The General Linear group $GL(n, R)$

This file defines the elements of the General Linear group `general_linear_group n R`,
consisting of all invertible `n` by `n` `R`-matrices.

## Main definitions

* `matrix.general_linear_group` is the type of matrices over R which are units in the matrix ring.
* `matrix.GL_pos` gives the subgroup of matrices with
  positive determinant (over a linear ordered ring).

## Tags

matrix group, group, matrix inverse
-/

namespace matrix
universes u v
open_locale matrix
open linear_map

-- disable this instance so we do not accidentally use it in lemmas.
local attribute [-instance] special_linear_group.has_coe_to_fun

/-- `GL n R` is the group of `n` by `n` `R`-matrices with unit determinant.
Defined as a subtype of matrices-/
abbreviation general_linear_group (n : Type u) (R : Type v)
  [decidable_eq n] [fintype n] [comm_ring R] : Type* := (matrix n n R)ˣ

notation `GL` := general_linear_group

namespace general_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

/-- The determinant of a unit matrix is itself a unit. -/
@[simps]
def det : GL n R →* Rˣ :=
{ to_fun := λ A,
  { val := (↑A : matrix n n R).det,
    inv := (↑(A⁻¹) : matrix n n R).det,
    val_inv := by rw [←det_mul, ←mul_eq_mul, A.mul_inv, det_one],
    inv_val := by rw [←det_mul, ←mul_eq_mul, A.inv_mul, det_one]},
  map_one' := units.ext det_one,
  map_mul' := λ A B, units.ext $ det_mul _ _ }

/--The `GL n R` and `general_linear_group R n` groups are multiplicatively equivalent-/
def to_lin : (GL n R) ≃* (linear_map.general_linear_group R (n → R)) :=
units.map_equiv to_lin_alg_equiv'.to_mul_equiv

/--Given a matrix with invertible determinant we get an element of `GL n R`-/
def mk' (A : matrix n n R) (h : invertible (matrix.det A)) : GL n R :=
unit_of_det_invertible A

/--Given a matrix with unit determinant we get an element of `GL n R`-/
noncomputable def mk'' (A : matrix n n R) (h : is_unit (matrix.det A)) : GL n R :=
nonsing_inv_unit A h

/--Given a matrix with non-zero determinant over a field, we get an element of `GL n K`-/
def mk_of_det_ne_zero {K : Type*} [field K] (A : matrix n n K) (h : matrix.det A ≠ 0) :
  GL n K :=
mk' A (invertible_of_nonzero h)

lemma ext_iff (A B : GL n R) : A = B ↔ (∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :=
units.ext_iff.trans matrix.ext_iff.symm

/-- Not marked `@[ext]` as the `ext` tactic already solves this. -/
lemma ext ⦃A B : GL n R⦄ (h : ∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :
  A = B :=
units.ext $ matrix.ext h

section coe_lemmas

variables (A B : GL n R)

@[simp] lemma coe_mul : ↑(A * B) = (↑A : matrix n n R) ⬝ (↑B : matrix n n R) := rfl

@[simp] lemma coe_one : ↑(1 : GL n R) = (1 : matrix n n R) := rfl

lemma coe_inv : ↑(A⁻¹) = (↑A : matrix n n R)⁻¹ :=
begin
  letI := A.invertible,
  exact inv_of_eq_nonsing_inv (↑A : matrix n n R),
end

/-- An element of the matrix general linear group on `(n) [fintype n]` can be considered as an
element of the endomorphism general linear group on `n → R`. -/
def to_linear : general_linear_group n R ≃* linear_map.general_linear_group R (n → R) :=
units.map_equiv matrix.to_lin_alg_equiv'.to_ring_equiv.to_mul_equiv

-- Note that without the `@` and `‹_›`, lean infers `λ a b, _inst a b` instead of `_inst` as the
-- decidability argument, which prevents `simp` from obtaining the instance by unification.
-- These `λ a b, _inst a b` terms also appear in the type of `A`, but simp doesn't get confused by
-- them so for now we do not care.
@[simp] lemma coe_to_linear :
  (@to_linear n ‹_› ‹_› _ _ A : (n → R) →ₗ[R] (n → R)) = matrix.mul_vec_lin A :=
rfl

@[simp] lemma to_linear_apply (v : n → R) :
  (@to_linear n ‹_› ‹_› _ _ A) v = matrix.mul_vec_lin ↑A v :=
rfl

end coe_lemmas

end general_linear_group

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

instance has_coe_to_general_linear_group : has_coe (special_linear_group n R) (GL n R) :=
⟨λ A, ⟨↑A, ↑(A⁻¹), congr_arg coe (mul_right_inv A), congr_arg coe (mul_left_inv A)⟩⟩

@[simp] lemma coe_to_GL_det (g : special_linear_group n R) : (g : GL n R).det = 1 :=
units.ext g.prop

end special_linear_group

section

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]

section
variables (n R)

/-- This is the subgroup of `nxn` matrices with entries over a
linear ordered ring and positive determinant. -/
def GL_pos : subgroup (GL n R) :=
(units.pos_subgroup R).comap general_linear_group.det
end

@[simp] lemma mem_GL_pos (A : GL n R) : A ∈ GL_pos n R ↔ 0 < (A.det : R) := iff.rfl

lemma GL_pos.det_ne_zero (A : GL_pos n R) : (A : matrix n n R).det ≠ 0 := ne_of_gt A.prop

end

section has_neg

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
[fact (even (fintype.card n))]

/-- Formal operation of negation on general linear group on even cardinality `n` given by negating
each element. -/
instance : has_neg (GL_pos n R) :=
⟨λ g, ⟨-g, begin
    rw [mem_GL_pos, general_linear_group.coe_det_apply, units.coe_neg, det_neg,
      (fact.out $ even $ fintype.card n).neg_one_pow, one_mul],
    exact g.prop,
  end⟩⟩

@[simp] lemma GL_pos.coe_neg_GL (g : GL_pos n R) : ↑(-g) = -(g : GL n R) := rfl
@[simp] lemma GL_pos.coe_neg (g : GL_pos n R) : ↑(-g) = -(g : matrix n n R) := rfl

@[simp] lemma GL_pos.coe_neg_apply (g : GL_pos n R) (i j : n) :
  (↑(-g) : matrix n n R) i j = -((↑g : matrix n n R) i j) :=
rfl

instance : has_distrib_neg (GL_pos n R) :=
subtype.coe_injective.has_distrib_neg _ GL_pos.coe_neg_GL (GL_pos n R).coe_mul

end has_neg

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [linear_ordered_comm_ring R]

/-- `special_linear_group n R` embeds into `GL_pos n R` -/
def to_GL_pos : special_linear_group n R →* GL_pos n R :=
{ to_fun := λ A, ⟨(A : GL n R), show 0 < (↑A : matrix n n R).det, from A.prop.symm ▸ zero_lt_one⟩,
  map_one' := subtype.ext $ units.ext $ rfl,
  map_mul' := λ A₁ A₂, subtype.ext $ units.ext $ rfl }

instance : has_coe (special_linear_group n R) (GL_pos n R) := ⟨to_GL_pos⟩

lemma coe_eq_to_GL_pos : (coe : special_linear_group n R → GL_pos n R) = to_GL_pos := rfl

lemma to_GL_pos_injective :
  function.injective (to_GL_pos : special_linear_group n R → GL_pos n R) :=
(show function.injective ((coe : GL_pos n R → matrix n n R) ∘ to_GL_pos),
 from subtype.coe_injective).of_comp

/-- Coercing a `special_linear_group` via `GL_pos` and `GL` is the same as coercing striaght to a
matrix. -/
@[simp]
lemma coe_GL_pos_coe_GL_coe_matrix (g : special_linear_group n R) :
    (↑(↑(↑g : GL_pos n R) : GL n R) : matrix n n R) = ↑g := rfl

@[simp] lemma coe_to_GL_pos_to_GL_det (g : special_linear_group n R) :
  ((g : GL_pos n R) : GL n R).det = 1 :=
units.ext g.prop

variable [fact (even (fintype.card n))]

@[norm_cast] lemma coe_GL_pos_neg (g : special_linear_group n R) :
  ↑(-g) = -(↑g : GL_pos n R) := subtype.ext $ units.ext rfl

end special_linear_group

section examples

/-- The matrix [a, -b; b, a] (inspired by multiplication by a complex number); it is an element of
$GL_2(R)$ if `a ^ 2 + b ^ 2` is nonzero. -/
@[simps coe {fully_applied := ff}]
def plane_conformal_matrix {R} [field R] (a b : R) (hab : a ^ 2 + b ^ 2 ≠ 0) :
  matrix.general_linear_group (fin 2) R :=
general_linear_group.mk_of_det_ne_zero !![a, -b; b, a]
  (by simpa [det_fin_two, sq] using hab)

/- TODO: Add Iwasawa matrices `n_x=!![1,x; 0,1]`, `a_t=!![exp(t/2),0;0,exp(-t/2)]` and
  `k_θ=!![cos θ, sin θ; -sin θ, cos θ]`
-/

end examples

namespace general_linear_group
variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

-- this section should be last to ensure we do not use it in lemmas
section coe_fn_instance

/-- This instance is here for convenience, but is not the simp-normal form. -/
instance : has_coe_to_fun (GL n R) (λ _, n → n → R) :=
{ coe := λ A, A.val }

@[simp] lemma coe_fn_eq_coe (A : GL n R) : ⇑A = (↑A : matrix n n R) := rfl

end coe_fn_instance

end general_linear_group

end matrix


-- Introduccion_de_la_conjuncion.lean
-- Introducción de la conjunción.
-- José A. Alonso Jiménez
-- Sevilla, 12 de agosto de 2020
-- ---------------------------------------------------------------------

-- En este relación se muestra distintas formas de demostrar un teorema
-- con introducción de la conjunción.

-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones:
-- 1. Importar la librería de tácticas.
-- 2. Declarar P y Q como variables sobre proposiciones.
-- ----------------------------------------------------------------------

import tactic            -- 1
variables (P Q : Prop)   -- 2

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que de P y (P → Q) se deduce P ∧ Q
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
begin
  split,
  { exact hP },
  { apply hPQ,
    exact hP },
end

-- Comentario
-- ----------

-- La táctica split, cuando la conclusión es una conjunción, aplica la
-- regla de eliminación de la conjunción; es decir, si la conclusión es
-- (P ∧ Q), entonces crea dos subojetivos: el primero en el que la
-- conclusión es P y el segundo donde es Q.

-- 2ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
begin
  split,
  { exact hP },
  { exact hPQ hP },
end

-- 3ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
begin
  have hQ : Q := hPQ hP,
  show P ∧ Q, by exact ⟨hP, hQ⟩,
end

-- 4ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
begin
  show P ∧ Q, by exact ⟨hP, hPQ hP⟩,
end

-- 4ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
begin
  exact ⟨hP, hPQ hP⟩,
end

-- 5ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
by exact ⟨hP, hPQ hP⟩

-- 6ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
⟨hP, hPQ hP⟩

-- 7ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
and.intro hP (hPQ hP)

-- Comentario: Se ha usado el lema
-- + and.intro : P → Q → P ∧ Q

-- 8ª demostración
-- ===============

example
  (hP : P)
  (hPQ : P → Q)
  : P ∧ Q :=
by tauto


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

-- Sum a sequence by grouping adjacent terms.
-- TODO: move to mathlib.
lemma sum_pairs (n : ℕ) (f : ℕ → ℚ) :
  ∑ k in (finset.range (2 * n)), f k = ∑ k in (finset.range n), (f (2 * k) + f (2 * k + 1)) :=
begin
  induction n with pn hpn,
  { simp only [finset.sum_empty, finset.range_zero, mul_zero] },
  { have hs: (2 * pn.succ) = (2 * pn).succ.succ := rfl,
    rw [finset.sum_range_succ, ←hpn, hs, finset.sum_range_succ, finset.sum_range_succ],
    ring },
end

theorem aime_1984_p1
  (u : ℕ → ℚ)
  (h₀ : ∀ n, u (n + 1) = u n + 1)
  (h₁ : ∑ k in finset.range 98, u k.succ = 137) :
  ∑ k in finset.range 49, u (2 * k.succ) = 93 :=
begin
  -- We will use sum_pairs and h₀ to rewrite h₁ and the goal in terms of the quantity
  -- ∑ k in finset.range 49, u (2 * k + 1).

  have h₂ : ∀ k, k ∈ finset.range 49 → u (2 * k + 1 + 1) = u (2 * k + 1) + 1 :=
  by { intros k hk, exact h₀ (2 * k + 1) },

  have h₃: ∑ (x : ℕ) in finset.range 49, (1:ℚ) = 49 := by simp only [mul_one, nat.cast_bit0, finset.sum_const, nsmul_eq_mul, nat.cast_bit1, finset.card_range, nat.cast_one],

  have h98 : 98 = 2 * 49 := by norm_num,

  rw [h98, sum_pairs, finset.sum_add_distrib, finset.sum_congr rfl h₂,
     finset.sum_add_distrib, h₃, ←add_assoc] at h₁,

  have h₄ : ∑ (k : ℕ) in finset.range 49, u (2 * k.succ)
          = ∑ (k : ℕ) in finset.range 49, (u (2 * k + 1) + 1) :=
    finset.sum_congr rfl h₂,
  rw [h₄, finset.sum_add_distrib, h₃],

  linarith,
end