/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import order.filter.basic

/-!
# Filtros
La definición de `filtro` en Lean es la siguiente:

structure filter (α : Type*) :=
(sets                   : set (set α))
(univ_sets              : set.univ ∈ sets)
(sets_of_superset {x y} : x ∈ sets → x ⊆ y → y ∈ sets)
(inter_sets {x y}       : x ∈ sets → y ∈ sets → x ∩ y ∈ sets)

## Notación y resultados útiles.

Fijamos `α : Type`, `F : filter α` y `S : set α`.

Por definición, la notación `S ∈ F` significa `S ∈ F.sets`.
(La intuición es `F ⊆ S`, aunque por supuesto esto no tiene
sentido porque `F` es un filtro, no un subconjunto).

Dos filtros `F` y `G` son iguales si y sólo si
`∀ S, S ∈ F ↔ S ∈ G`.

Los lemas correspondientes a las condiciones que
aparecen en la definición de filtro son:

`univ_mem : univ ∈ F`
`mem_of_superset : S ∈ F → S ⊆ T → T ∈ F`
`inter_mem : S ∈ F → T ∈ F → S ∩ T ∈ F`

Estos lemas están en el espacio de nombres `filter`.
-/

-- Abrimos los espacios de nombres `filter` y `set`.
open filter set

--  Sea `α` un tipo, `F` un filtro sobre `α`, y `S` y `T` dos subconjuntos de `α`.
variables (α : Type) (F : filter α) (S T : set α)

/-
Dos subconjuntos `S` y `T` están en un filtro `F` si y sólo
si su intersección está en `F`.

Los lemas `inter_subset_left S T : S ∩ T ⊆ S` e `inter_subset_right S T : S ∩ T ⊆ S`
son útiles para esta demostración.
-/
example : S ∩ T ∈ F ↔ S ∈ F ∧ T ∈ F :=
begin
  sorry
end

/-! ## Ejemplos de filtros -/

/- ### Filtros principales
Dado un subconjunto `X` de `α`, el filtro principal de `X` es la
colección de subconjuntos de `α` que contienen `X`.
Está definido en mathlib, y denotado mediante `𝓟 X`, pero en
este ejemplo vamos a demostrar nosotros mismos que es un filtro.

Lemas útiles:
`mem_univ s : s ∈ univ`
`subset.trans : A ⊆ B → B ⊆ C → A ⊆ C`
`subset_inter : X ⊆ S → X ⊆ T → X ⊆ S ∩ T`
`mem_set_of_eq : x ∈ {a : α | p a} = p x`
-/

-- El filtro principal de `X`.
example (X : set α) : filter α :=
{ sets := {S : set α | X ⊆ S},
  univ_sets := begin
    sorry
  end,
  sets_of_superset := begin
    sorry
  end,
  inter_sets := begin
    sorry
  end }

/-- ### EL filtro `at_top` en un conjunto totalmente ordenado

Sea `L` un conjunto linearmente ordenado no vacío.
Vamos a construir un filtro `at_top` que representa un
"entorno infinitesimal" de `∞`. En concreto, los conjuntos
pertenecientes a este filtro serán aquellos `X : set L`
para los que existe un `x : L` tal que para todo `y ≥ x`, `y ∈ X`.
-/
def at_top (L : Type) [linear_order L] (e : L) : filter L :=
{ sets := {X : set L | ∃ x : L, ∀ y, x ≤ y → y ∈ X},
  univ_sets := begin
    sorry
  end,
  sets_of_superset := begin
    sorry
  end,
  inter_sets := begin
    sorry
  end }

/-! ### El filtro cofinito
El filtro cofinito en un tipo `α` es la colección de subconjuntos `S : set α`
con la propiedad de que el complemento `Sᶜ`de `S` es finito.

Lemas útiles:
`compl_univ : univᶜ = ∅`
`finite_empty : finite ∅`
`compl_subset_compl : Xᶜ ⊆ Yᶜ ↔ Y ⊆ X`
`finite.subset : S.finite → ∀ {T : set α}, T ⊆ S → T.finite`
`compl_inter S T : (S ∩ T)ᶜ = Sᶜ ∪ Tᶜ`
`finite.union : S.finite → T.finite → (S ∪ T).finite`.
-/
def cofinite (α : Type) : filter α :=
{ sets := { S : set α | (Sᶜ).finite },
  univ_sets := begin
    sorry
  end,
  sets_of_superset := begin
    sorry
  end,
  inter_sets := begin
    sorry
  end }

-- Esta instrucción nos permite acceder a la notación `𝓟 X` para el filtro principal
open_locale filter

/-!
## El orden (≤) sobre los filtros de `α`
Los filtros están parcialmente ordenados, mediante la relación `≤`
definida mediante `F ≤ G` si y sólo si `G.sets ⊆ F.sets`.
(Cuanto más pequeño es el filtro `F`, más grande es la colección
`F.sets`, ya que el "conjunto generalizado" `F` está "contenido"
en más conjuntos).

En este ejemplo vamos a demostrar que `𝓟 S ≤ 𝓟 T ↔ S ⊆ T`.
Esto es lo que dice el lema `principal_mono` de mathlib,
pero vamos a demostrarlo utilizando los lemas:
`mem_principal : T ∈ 𝓟 S ↔ S ⊆ T`
`mem_principal_self S : S ∈ 𝓟 S`
`le_def : F ≤ G ↔ ∀ (S : set α), S ∈ G → S ∈ F`
-/

example (S T : set α) : 𝓟 S ≤ 𝓟 T ↔ S ⊆ T :=
begin
  sorry
end

/- Este ejemplo se llama `le_principal_iff` en mathlib, pero podemos demostrarlo a
  partir de las definiciones y lemas anteriores. -/
example (F : filter α) (S : set α) : F ≤ 𝓟 S ↔ S ∈ F :=
begin
  sorry
end


/-
Copyright (c) 2023 Bruno Bentzen. All rights reserved.
Released under the Apache License 2.0 (see "License");
Author: Bruno Bentzen
-/

import ..default

open form

/- Hilbert-style axiomatization of intuitionistic propositional logic -/

inductive prf : set form → form → Prop
| ax {Γ} {p} (h : p ∈ Γ) : prf Γ p
| k {Γ} {p q} : prf Γ (p ⊃ (q ⊃ p))
| s {Γ} {p q r} : prf Γ ((p ⊃ (q ⊃ r)) ⊃ ((p ⊃ q) ⊃ (p ⊃ r)))
| exf {Γ} {p} : prf Γ (⊥ ⊃ p)
| mp {Γ} {p q} (hpq: prf Γ (p ⊃ q)) (hp : prf Γ p) : prf Γ q
| pr1 {Γ} {p q} : prf Γ ((p & q) ⊃ p)
| pr2 {Γ} {p q} : prf Γ ((p & q) ⊃ q)
| pair {Γ} {p q} : prf Γ (p ⊃ (q ⊃ (p & q)))
| inr {Γ} {p q} : prf Γ (p ⊃ (p ∨ q))
| inl {Γ} {p q} : prf Γ (q ⊃ (p ∨ q))
| case {Γ} {p q r} : prf Γ ((p ⊃ r) ⊃ ((q ⊃ r) ⊃ ((p ∨ q) ⊃ r)))

notation Γ ` ⊢ᵢ ` p := prf Γ p
notation Γ ` ⊬ᵢ ` p := prf Γ p → false

/- some helpful lemmas -/

namespace prf

lemma id {p : form } {Γ :  set form } :
  Γ ⊢ᵢ p ⊃ p :=
mp (mp (@s  Γ p (p ⊃ p) p) k) k

theorem deduction {Γ :  set form } {p q : form } :
  (Γ ⸴ p ⊢ᵢ q) → (Γ ⊢ᵢ p ⊃ q) :=
begin
  generalize eq : (Γ ⸴ p) = Γ',
  intro h,
  induction h; subst eq,
  { repeat {cases h_h},
    exact id,
    { exact mp k (ax h_h) } },
  { exact mp k k },
  { exact mp k s },
  { exact mp k exf },
  { apply mp,
    { exact (mp s (h_ih_hpq rfl)) },
    { exact h_ih_hp rfl } },
  { exact mp k pr1 },
  { exact mp k pr2 },
  { exact mp k pair },
  { exact mp k inr },
  { exact mp k inl },
  { exact mp k case }
end

theorem contradeduction {Γ :  set form } {p q : form } :
  (Γ ⊬ᵢ p ⊃ q) → (Γ ⸴ p ⊬ᵢ q) :=
begin
  intros hn h,
  exact hn (prf.deduction h)
end

-- helpful for the compl proof

lemma or_intro1 {p : form } {Γ :  set form } (q) :
  (Γ ⊢ᵢ p) → (Γ ⊢ᵢ p ∨ q) :=
begin
  intros hp,
  apply prf.mp,
  { apply prf.inr },
  { assumption }
end

lemma or_intro2 {q : form } {Γ :  set form } (p) :
  (Γ ⊢ᵢ q) → (Γ ⊢ᵢ p ∨ q) :=
begin
  intros hp,
  apply prf.mp,
  { apply prf.inl },
  { assumption }
end

lemma or_elim {p q r : form } {Γ :  set form } :
  (Γ ⊢ᵢ p ∨ q) → (Γ ⸴ p ⊢ᵢ r) → (Γ ⸴ q ⊢ᵢ r) → (Γ ⊢ᵢ r) :=
begin
  intros hpq hp hq,
  apply prf.mp,
  { apply prf.mp,
    apply prf.mp,
    { apply prf.case,
      exact p,
      exact q},
    repeat {apply deduction, assumption} },
  { assumption }
end

lemma and_elim1 {p q : form } {Γ :  set form } :
  (Γ ⊢ᵢ (p & q)) → (Γ ⊢ᵢ p) :=
begin
  intros hp,
  apply prf.mp,
  { apply prf.pr1, exact q },
  { assumption }
end

lemma and_elim2 {p q : form } {Γ :  set form } :
  (Γ ⊢ᵢ (p & q)) → (Γ ⊢ᵢ q) :=
begin
  intros hp,
  apply prf.mp,
  { apply prf.pr2, exact p },
  { assumption },
end

/- structural rules -/

lemma sub_weak {Γ Δ :  set form } {p : form } :
  (Δ ⊢ᵢ p) → (Δ ⊆ Γ) → (Γ ⊢ᵢ p) :=
begin
  intros hp h,
  induction hp,
  { apply ax, exact h hp_h },
  { exact k },
  { exact s },
  { exact exf },
  { apply mp,
    { exact hp_ih_hpq h },
    {exact hp_ih_hp h} },
  { exact pr1 },
  { exact pr2 },
  { exact pair },
  { exact inr },
  { exact inl },
  { exact case }
end

end prf


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.complex.arg
import analysis.special_functions.log.basic

/-!
# The complex `log` function

Basic properties, relationship with `exp`.
-/

noncomputable theory

namespace complex

open set filter

open_locale real topological_space

/-- Inverse of the `exp` function. Returns values such that `(log x).im > - π` and `(log x).im ≤ π`.
  `log 0 = 0`-/
@[pp_nodot] noncomputable def log (x : ℂ) : ℂ := x.abs.log + arg x * I

lemma log_re (x : ℂ) : x.log.re = x.abs.log := by simp [log]

lemma log_im (x : ℂ) : x.log.im = x.arg := by simp [log]

lemma neg_pi_lt_log_im (x : ℂ) : -π < (log x).im := by simp only [log_im, neg_pi_lt_arg]
lemma log_im_le_pi (x : ℂ) : (log x).im ≤ π := by simp only [log_im, arg_le_pi]

lemma exp_log {x : ℂ} (hx : x ≠ 0) : exp (log x) = x :=
by rw [log, exp_add_mul_I, ← of_real_sin, sin_arg, ← of_real_cos, cos_arg hx,
  ← of_real_exp, real.exp_log (abs_pos.2 hx), mul_add, of_real_div, of_real_div,
  mul_div_cancel' _ (of_real_ne_zero.2 (mt abs_eq_zero.1 hx)), ← mul_assoc,
  mul_div_cancel' _ (of_real_ne_zero.2 (mt abs_eq_zero.1 hx)), re_add_im]

@[simp] lemma range_exp : range exp = {0}ᶜ :=
set.ext $ λ x, ⟨by { rintro ⟨x, rfl⟩, exact exp_ne_zero x }, λ hx, ⟨log x, exp_log hx⟩⟩

lemma log_exp {x : ℂ} (hx₁ : -π < x.im) (hx₂: x.im ≤ π) : log (exp x) = x :=
by rw [log, abs_exp, real.log_exp, exp_eq_exp_re_mul_sin_add_cos, ← of_real_exp,
  arg_mul_cos_add_sin_mul_I (real.exp_pos _) ⟨hx₁, hx₂⟩, re_add_im]

lemma of_real_log {x : ℝ} (hx : 0 ≤ x) : (x.log : ℂ) = log x :=
complex.ext
  (by rw [log_re, of_real_re, abs_of_nonneg hx])
  (by rw [of_real_im, log_im, arg_of_real_of_nonneg hx])

lemma log_of_real_re (x : ℝ) : (log (x : ℂ)).re = real.log x := by simp [log_re]

@[simp] lemma log_zero : log 0 = 0 := by simp [log]

@[simp] lemma log_one : log 1 = 0 := by simp [log]

lemma log_neg_one : log (-1) = π * I := by simp [log]

lemma log_I : log I = π / 2 * I := by simp [log]

lemma log_neg_I : log (-I) = -(π / 2) * I := by simp [log]

lemma two_pi_I_ne_zero : (2 * π * I : ℂ) ≠ 0 :=
by norm_num [real.pi_ne_zero, I_ne_zero]

lemma exp_eq_one_iff {x : ℂ} : exp x = 1 ↔ ∃ n : ℤ, x = n * ((2 * π) * I) :=
begin
  split,
  { intro h,
    rcases exists_unique_add_zsmul_mem_Ioc real.two_pi_pos x.im (-π) with ⟨n, hn, -⟩,
    use -n,
    rw [int.cast_neg, neg_mul, eq_neg_iff_add_eq_zero],
    have : (x + n * (2 * π * I)).im ∈ Ioc (-π) π, by simpa [two_mul, mul_add] using hn,
    rw [← log_exp this.1 this.2, exp_periodic.int_mul n, h, log_one] },
  { rintro ⟨n, rfl⟩, exact (exp_periodic.int_mul n).eq.trans exp_zero }
end

lemma exp_eq_exp_iff_exp_sub_eq_one {x y : ℂ} : exp x = exp y ↔ exp (x - y) = 1 :=
by rw [exp_sub, div_eq_one_iff_eq (exp_ne_zero _)]

lemma exp_eq_exp_iff_exists_int {x y : ℂ} : exp x = exp y ↔ ∃ n : ℤ, x = y + n * ((2 * π) * I) :=
by simp only [exp_eq_exp_iff_exp_sub_eq_one, exp_eq_one_iff, sub_eq_iff_eq_add']

@[simp] lemma countable_preimage_exp {s : set ℂ} : (exp ⁻¹' s).countable ↔ s.countable :=
begin
  refine ⟨λ hs, _, λ hs, _⟩,
  { refine ((hs.image exp).insert 0).mono _,
    rw [image_preimage_eq_inter_range, range_exp, ← diff_eq, ← union_singleton, diff_union_self],
    exact subset_union_left _ _ },
  { rw ← bUnion_preimage_singleton,
    refine hs.bUnion (λ z hz, _),
    rcases em (∃ w, exp w = z) with ⟨w, rfl⟩|hne,
    { simp only [preimage, mem_singleton_iff, exp_eq_exp_iff_exists_int, set_of_exists],
      exact countable_Union (λ m, countable_singleton _) },
    { push_neg at hne, simp [preimage, hne] } }
end

alias countable_preimage_exp ↔ _ set.countable.preimage_cexp

lemma tendsto_log_nhds_within_im_neg_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  tendsto log (𝓝[{z : ℂ | z.im < 0}] z) (𝓝 $ real.log (abs z) - π * I) :=
begin
  have := (continuous_of_real.continuous_at.comp_continuous_within_at
    (continuous_abs.continuous_within_at.log _)).tendsto.add
    (((continuous_of_real.tendsto _).comp $
    tendsto_arg_nhds_within_im_neg_of_re_neg_of_im_zero hre him).mul tendsto_const_nhds),
  convert this,
  { simp [sub_eq_add_neg] },
  { lift z to ℝ using him, simpa using hre.ne }
end

lemma continuous_within_at_log_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  continuous_within_at log {z : ℂ | 0 ≤ z.im} z :=
begin
  have := (continuous_of_real.continuous_at.comp_continuous_within_at
    (continuous_abs.continuous_within_at.log _)).tendsto.add
    ((continuous_of_real.continuous_at.comp_continuous_within_at $
    continuous_within_at_arg_of_re_neg_of_im_zero hre him).mul tendsto_const_nhds),
  convert this,
  { lift z to ℝ using him, simpa using hre.ne }
end

lemma tendsto_log_nhds_within_im_nonneg_of_re_neg_of_im_zero
  {z : ℂ} (hre : z.re < 0) (him : z.im = 0) :
  tendsto log (𝓝[{z : ℂ | 0 ≤ z.im}] z) (𝓝 $ real.log (abs z) + π * I) :=
by simpa only [log, arg_eq_pi_iff.2 ⟨hre, him⟩]
  using (continuous_within_at_log_of_re_neg_of_im_zero hre him).tendsto

@[simp] lemma map_exp_comap_re_at_bot : map exp (comap re at_bot) = 𝓝[≠] 0 :=
by rw [← comap_exp_nhds_zero, map_comap, range_exp, nhds_within]

@[simp] lemma map_exp_comap_re_at_top : map exp (comap re at_top) = comap abs at_top :=
begin
  rw [← comap_exp_comap_abs_at_top, map_comap, range_exp, inf_eq_left, le_principal_iff],
  exact eventually_ne_of_tendsto_norm_at_top tendsto_comap 0
end

end complex

section log_deriv

open complex filter
open_locale topological_space

variables {α : Type*}

lemma continuous_at_clog {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) :
  continuous_at log x :=
begin
  refine continuous_at.add _ _,
  { refine continuous_of_real.continuous_at.comp _,
    refine (real.continuous_at_log _).comp complex.continuous_abs.continuous_at,
    rw abs_ne_zero,
    rintro rfl,
    simpa using h },
  { have h_cont_mul : continuous (λ x : ℂ, x * I), from continuous_id'.mul continuous_const,
    refine h_cont_mul.continuous_at.comp (continuous_of_real.continuous_at.comp _),
    exact continuous_at_arg h, },
end

lemma filter.tendsto.clog {l : filter α} {f : α → ℂ} {x : ℂ} (h : tendsto f l (𝓝 x))
  (hx : 0 < x.re ∨ x.im ≠ 0) :
  tendsto (λ t, log (f t)) l (𝓝 $ log x) :=
(continuous_at_clog hx).tendsto.comp h

variables [topological_space α]

lemma continuous_at.clog {f : α → ℂ} {x : α} (h₁ : continuous_at f x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  continuous_at (λ t, log (f t)) x :=
h₁.clog h₂

lemma continuous_within_at.clog {f : α → ℂ} {s : set α} {x : α} (h₁ : continuous_within_at f s x)
  (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) :
  continuous_within_at (λ t, log (f t)) s x :=
h₁.clog h₂

lemma continuous_on.clog {f : α → ℂ} {s : set α} (h₁ : continuous_on f s)
  (h₂ : ∀ x ∈ s, 0 < (f x).re ∨ (f x).im ≠ 0) :
  continuous_on (λ t, log (f t)) s :=
λ x hx, (h₁ x hx).clog (h₂ x hx)

lemma continuous.clog {f : α → ℂ} (h₁ : continuous f) (h₂ : ∀ x, 0 < (f x).re ∨ (f x).im ≠ 0) :
  continuous (λ t, log (f t)) :=
continuous_iff_continuous_at.2 $ λ x, h₁.continuous_at.clog (h₂ x)

end log_deriv


import ..lectures.love03_forward_proofs_demo

/-! # LoVe Exercise 4: Functional Programming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Reverse of a List

We define a new accumulator-based version of `reverse`. The first argument,
`as`, serves as the accumulator. This definition is __tail-recursive__, meaning
that compilers and interpreters can easily optimize the recursion away,
resulting in more efficient code. -/

def accurev {α : Type} : list α → list α → list α
| as []        := as
| as (x :: xs) := accurev (x :: as) xs

/-! 1.1. Our intention is that `accurev [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using the
`induction'` tactic or pattern matching): -/

lemma accurev_eq_reverse_append {α : Type} :
  ∀as xs : list α, accurev as xs = reverse xs ++ as :=
sorry

/-! 1.2. Derive the desired equation. -/

lemma accurev_eq_reverse {α : Type} (xs : list α) :
  accurev [] xs = reverse xs :=
sorry

/-! 1.3. Prove the following property.

Hint: A one-line inductionless proof is possible. -/

lemma accurev_accurev {α : Type} (xs : list α) :
  accurev [] (accurev [] xs) = xs :=
sorry

/-! 1.4. Prove the following lemma by structural induction, as a "paper" proof.
This is a good exercise to develop a deeper understanding of how structural
induction works (and is good practice for the final exam).

    lemma accurev_eq_reverse_append {α : Type} :
      ∀as xs : list α, accurev as xs = reverse xs ++ as

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `cc` need
not be justified if you think they are obvious (to humans), but you should say
which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

-- enter your paper proof here

/-! ## Question 2: Drop and Take

The `drop` function removes the first `n` elements from the front of a list. -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

/-! 2.1. Define the `take` function, which returns a list consisting of the the
first `n` elements at the front of a list.

To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

def take {α : Type} : ℕ → list α → list α :=
sorry

#eval take 0 [3, 7, 11]   -- expected: []
#eval take 1 [3, 7, 11]   -- expected: [3]
#eval take 2 [3, 7, 11]   -- expected: [3, 7]
#eval take 3 [3, 7, 11]   -- expected: [3, 7, 11]
#eval take 4 [3, 7, 11]   -- expected: [3, 7, 11]

#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/-! 2.2. Prove the following lemmas, using `induction'` or pattern matching.
Notice that they are registered as simplification rules thanks to the `@[simp]`
attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = [] :=
sorry

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = [] :=
sorry

/-! 2.3. Follow the recursion pattern of `drop` and `take` to prove the
following lemmas. In other words, for each lemma, there should be three cases,
and the third case will need to invoke the induction hypothesis.

Hint: Note that there are three variables in the `drop_drop` lemma (but only two
arguments to `drop`). For the third case, `←add_assoc` might be useful. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
-- supply the two missing cases here

lemma take_take {α : Type} :
  ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs :=
sorry

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs :=
sorry

/-! ## Question 3: A Type of λ-Terms

3.1. Define an inductive type corresponding to the untyped λ-terms, as given
by the following context-free grammar:

    term ::= 'var' string        -- variable (e.g., `x`)
           | 'lam' string term   -- λ-expression (e.g., `λx, t`)
           | 'app' term term     -- application (e.g., `t u`) -/

-- enter your definition here

/-! 3.2. Register a textual representation of the type `term` as an instance of
the `has_repr` type class. Make sure to supply enough parentheses to guarantee
that the output is unambiguous. -/

def term.repr : term → string
-- enter your answer here

@[instance] def term.has_repr : has_repr term :=
{ repr := term.repr }

/-! 3.3. Test your textual representation. The following command should print
something like `(λx, ((y x) x))`. -/

#eval (term.lam "x" (term.app (term.app (term.var "y") (term.var "x"))
    (term.var "x")))

end LoVe


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

import algebra.algebra.basic
import algebra.order.smul

/-!
# Ordered algebras

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

An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring,
for which scalar multiplication is "compatible" with the two orders.

The prototypical example is 2x2 matrices over the reals or complexes (or indeed any C^* algebra)
where the ordering the one determined by the positive cone of positive operators,
i.e. `A ≤ B` iff `B - A = star R * R` for some `R`.
(We don't yet have this example in mathlib.)

## Implementation

Because the axioms for an ordered algebra are exactly the same as those for the underlying
module being ordered, we don't actually introduce a new class, but just use the `ordered_smul`
mixin.

## Tags

ordered algebra
-/

section ordered_algebra

variables {R A : Type*} {a b : A} {r : R}

variables [ordered_comm_ring R] [ordered_ring A] [algebra R A] [ordered_smul R A]

lemma algebra_map_monotone : monotone (algebra_map R A) :=
λ a b h,
begin
  rw [algebra.algebra_map_eq_smul_one, algebra.algebra_map_eq_smul_one, ←sub_nonneg, ←sub_smul],
  transitivity (b - a) • (0 : A),
  { simp, },
  { exact smul_le_smul_of_nonneg zero_le_one (sub_nonneg.mpr h) }
end

end ordered_algebra


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

! This file was ported from Lean 3 source module category_theory.abelian.transfer
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Abelian.Basic
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.Kernels
import Mathbin.CategoryTheory.Adjunction.Limits

/-!
# Transferring "abelian-ness" across a functor

If `C` is an additive category, `D` is an abelian category,
we have `F : C ⥤ D` `G : D ⥤ C` (both preserving zero morphisms),
`G` is left exact (that is, preserves finite limits),
and further we have `adj : G ⊣ F` and `i : F ⋙ G ≅ 𝟭 C`,
then `C` is also abelian.

See <https://stacks.math.columbia.edu/tag/03A3>

## Notes
The hypotheses, following the statement from the Stacks project,
may appear suprising: we don't ask that the counit of the adjunction is an isomorphism,
but just that we have some potentially unrelated isomorphism `i : F ⋙ G ≅ 𝟭 C`.

However Lemma A1.1.1 from [Elephant] shows that in this situation the counit itself
must be an isomorphism, and thus that `C` is a reflective subcategory of `D`.

Someone may like to formalize that lemma, and restate this theorem in terms of `reflective`.
(That lemma has a nice string diagrammatic proof that holds in any bicategory.)
-/

noncomputable section

namespace CategoryTheory

open CategoryTheory.Limits

universe v u₁ u₂

namespace AbelianOfAdjunction

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

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

variable (F : C ⥤ D)

variable (G : D ⥤ C) [Functor.PreservesZeroMorphisms G]

variable (i : F ⋙ G ≅ 𝟭 C) (adj : G ⊣ F)

include i

/-- No point making this an instance, as it requires `i`. -/
theorem hasKernels [PreservesFiniteLimits G] : HasKernels C :=
  {
    HasLimit := fun X Y f => by
      have := nat_iso.naturality_1 i f
      simp at this
      rw [← this]
      haveI : has_kernel (G.map (F.map f) ≫ i.hom.app _) := limits.has_kernel_comp_mono _ _
      apply limits.has_kernel_iso_comp }
#align category_theory.abelian_of_adjunction.has_kernels CategoryTheory.AbelianOfAdjunction.hasKernels

include adj

/-- No point making this an instance, as it requires `i` and `adj`. -/
theorem hasCokernels : HasCokernels C :=
  {
    HasColimit := fun X Y f =>
      by
      haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits
      have := nat_iso.naturality_1 i f
      simp at this
      rw [← this]
      haveI : has_cokernel (G.map (F.map f) ≫ i.hom.app _) := limits.has_cokernel_comp_iso _ _
      apply limits.has_cokernel_epi_comp }
#align category_theory.abelian_of_adjunction.has_cokernels CategoryTheory.AbelianOfAdjunction.hasCokernels

variable [Limits.HasCokernels C]

/-- Auxiliary construction for `coimage_iso_image` -/
def cokernelIso {X Y : C} (f : X ⟶ Y) : G.obj (cokernel (F.map f)) ≅ cokernel f :=
  by
  -- We have to write an explicit `preserves_colimits` type here,
  -- as `left_adjoint_preserves_colimits` has universe variables.
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits
  calc
    G.obj (cokernel (F.map f)) ≅ cokernel (G.map (F.map f)) :=
      (as_iso (cokernel_comparison _ G)).symm
    _ ≅ cokernel (_ ≫ f ≫ _) := (cokernel_iso_of_eq (nat_iso.naturality_2 i f).symm)
    _ ≅ cokernel (f ≫ _) := (cokernel_epi_comp _ _)
    _ ≅ cokernel f := cokernel_comp_is_iso _ _

#align category_theory.abelian_of_adjunction.cokernel_iso CategoryTheory.AbelianOfAdjunction.cokernelIso

variable [Limits.HasKernels C] [PreservesFiniteLimits G]

/-- Auxiliary construction for `coimage_iso_image` -/
def coimageIsoImageAux {X Y : C} (f : X ⟶ Y) :
    kernel (G.map (cokernel.π (F.map f))) ≅ kernel (cokernel.π f) :=
  by
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits
  calc
    kernel (G.map (cokernel.π (F.map f))) ≅
        kernel (cokernel.π (G.map (F.map f)) ≫ cokernel_comparison (F.map f) G) :=
      kernel_iso_of_eq (π_comp_cokernel_comparison _ _).symm
    _ ≅ kernel (cokernel.π (G.map (F.map f))) := (kernel_comp_mono _ _)
    _ ≅ kernel (cokernel.π (_ ≫ f ≫ _) ≫ (cokernel_iso_of_eq _).Hom) :=
      (kernel_iso_of_eq (π_comp_cokernel_iso_of_eq_hom (nat_iso.naturality_2 i f)).symm)
    _ ≅ kernel (cokernel.π (_ ≫ f ≫ _)) := (kernel_comp_mono _ _)
    _ ≅ kernel (cokernel.π (f ≫ i.inv.app Y) ≫ (cokernel_epi_comp (i.hom.app X) _).inv) :=
      (kernel_iso_of_eq (by simp only [cokernel.π_desc, cokernel_epi_comp_inv]))
    _ ≅ kernel (cokernel.π (f ≫ _)) := (kernel_comp_mono _ _)
    _ ≅ kernel (inv (i.inv.app Y) ≫ cokernel.π f ≫ (cokernel_comp_is_iso f (i.inv.app Y)).inv) :=
      (kernel_iso_of_eq
        (by
          simp only [cokernel.π_desc, cokernel_comp_is_iso_inv, iso.hom_inv_id_app_assoc,
            nat_iso.inv_inv_app]))
    _ ≅ kernel (cokernel.π f ≫ _) := (kernel_is_iso_comp _ _)
    _ ≅ kernel (cokernel.π f) := kernel_comp_mono _ _

#align category_theory.abelian_of_adjunction.coimage_iso_image_aux CategoryTheory.AbelianOfAdjunction.coimageIsoImageAux

variable [Functor.PreservesZeroMorphisms F]

/-- Auxiliary definition: the abelian coimage and abelian image agree.
We still need to check that this agrees with the canonical morphism.
-/
def coimageIsoImage {X Y : C} (f : X ⟶ Y) : Abelian.coimage f ≅ Abelian.image f :=
  by
  haveI : preserves_limits F := adj.right_adjoint_preserves_limits
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits
  calc
    abelian.coimage f ≅ cokernel (kernel.ι f) := iso.refl _
    _ ≅ G.obj (cokernel (F.map (kernel.ι f))) := (cokernel_iso _ _ i adj _).symm
    _ ≅ G.obj (cokernel (kernel_comparison f F ≫ kernel.ι (F.map f))) :=
      (G.map_iso (cokernel_iso_of_eq (by simp)))
    _ ≅ G.obj (cokernel (kernel.ι (F.map f))) := (G.map_iso (cokernel_epi_comp _ _))
    _ ≅ G.obj (abelian.coimage (F.map f)) := (iso.refl _)
    _ ≅ G.obj (abelian.image (F.map f)) := (G.map_iso (abelian.coimage_iso_image _))
    _ ≅ G.obj (kernel (cokernel.π (F.map f))) := (iso.refl _)
    _ ≅ kernel (G.map (cokernel.π (F.map f))) := (preserves_kernel.iso _ _)
    _ ≅ kernel (cokernel.π f) := (coimage_iso_image_aux F G i adj f)
    _ ≅ abelian.image f := iso.refl _

#align category_theory.abelian_of_adjunction.coimage_iso_image CategoryTheory.AbelianOfAdjunction.coimageIsoImage

attribute [local simp] cokernel_iso coimage_iso_image coimage_iso_image_aux

-- The account of this proof in the Stacks project omits this calculation.
theorem coimageIsoImage_hom {X Y : C} (f : X ⟶ Y) :
    (coimageIsoImage F G i adj f).Hom = Abelian.coimageImageComparison f :=
  by
  ext
  simpa only [← G.map_comp_assoc, coimage_iso_image, nat_iso.inv_inv_app, cokernel_iso,
    coimage_iso_image_aux, iso.trans_symm, iso.symm_symm_eq, iso.refl_trans, iso.trans_refl,
    iso.trans_hom, iso.symm_hom, cokernel_comp_is_iso_inv, cokernel_epi_comp_inv, as_iso_hom,
    functor.map_iso_hom, cokernel_epi_comp_hom, preserves_kernel.iso_hom, kernel_comp_mono_hom,
    kernel_is_iso_comp_hom, cokernel_iso_of_eq_hom_comp_desc_assoc, cokernel.π_desc_assoc,
    category.assoc, π_comp_cokernel_iso_of_eq_inv_assoc, π_comp_cokernel_comparison_assoc,
    kernel.lift_ι, kernel.lift_ι_assoc, kernel_iso_of_eq_hom_comp_ι_assoc,
    kernel_comparison_comp_ι_assoc, abelian.coimage_image_factorisation] using
    nat_iso.naturality_1 i f
#align category_theory.abelian_of_adjunction.coimage_iso_image_hom CategoryTheory.AbelianOfAdjunction.coimageIsoImage_hom

end AbelianOfAdjunction

open AbelianOfAdjunction

/-- If `C` is an additive category, `D` is an abelian category,
we have `F : C ⥤ D` `G : D ⥤ C` (both preserving zero morphisms),
`G` is left exact (that is, preserves finite limits),
and further we have `adj : G ⊣ F` and `i : F ⋙ G ≅ 𝟭 C`,
then `C` is also abelian.

See <https://stacks.math.columbia.edu/tag/03A3>
-/
def abelianOfAdjunction {C : Type u₁} [Category.{v} C] [Preadditive C] [HasFiniteProducts C]
    {D : Type u₂} [Category.{v} D] [Abelian D] (F : C ⥤ D) [Functor.PreservesZeroMorphisms F]
    (G : D ⥤ C) [Functor.PreservesZeroMorphisms G] [PreservesFiniteLimits G] (i : F ⋙ G ≅ 𝟭 C)
    (adj : G ⊣ F) : Abelian C := by
  haveI := has_kernels F G i
  haveI := has_cokernels F G i adj
  have : ∀ {X Y : C} (f : X ⟶ Y), is_iso (abelian.coimage_image_comparison f) :=
    by
    intro X Y f
    rw [← coimage_iso_image_hom F G i adj f]
    infer_instance
  apply abelian.of_coimage_image_comparison_is_iso
#align category_theory.abelian_of_adjunction CategoryTheory.abelianOfAdjunction

/-- If `C` is an additive category equivalent to an abelian category `D`
via a functor that preserves zero morphisms,
then `C` is also abelian.
-/
def abelianOfEquivalence {C : Type u₁} [Category.{v} C] [Preadditive C] [HasFiniteProducts C]
    {D : Type u₂} [Category.{v} D] [Abelian D] (F : C ⥤ D) [Functor.PreservesZeroMorphisms F]
    [IsEquivalence F] : Abelian C :=
  abelianOfAdjunction F F.inv F.asEquivalence.unitIso.symm F.asEquivalence.symm.toAdjunction
#align category_theory.abelian_of_equivalence CategoryTheory.abelianOfEquivalence

end CategoryTheory


/-
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, Yury Kudryashov
! This file was ported from Lean 3 source module order.bounds.order_iso
! leanprover-community/mathlib commit a59dad53320b73ef180174aae867addd707ef00e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Bounds.Basic
import Mathlib.Order.Hom.Set

/-!
# Order isomorphisms and bounds.
-/

open Set

namespace OrderIso

variable [Preorder α] [Preorder β] (f : α ≃o β)

theorem upperBounds_image {s : Set α} : upperBounds (f '' s) = f '' upperBounds s :=
  Subset.antisymm
    (fun x hx =>
      ⟨f.symm x, fun _ hy => f.le_symm_apply.2 (hx <| mem_image_of_mem _ hy), f.apply_symm_apply x⟩)
    f.monotone.image_upperBounds_subset_upperBounds_image
#align order_iso.upper_bounds_image OrderIso.upperBounds_image

theorem lowerBounds_image {s : Set α} : lowerBounds (f '' s) = f '' lowerBounds s :=
  @upperBounds_image αᵒᵈ βᵒᵈ _ _ f.dual _
#align order_iso.lower_bounds_image OrderIso.lowerBounds_image

-- Porting note: by simps were `fun _ _ => f.le_iff_le` and `fun _ _ => f.symm.le_iff_le`
@[simp]

theorem isLUB_image' {s : Set α} {x : α} : IsLUB (f '' s) (f x) ↔ IsLUB s x := by
  rw [isLUB_image, f.symm_apply_apply]
#align order_iso.is_lub_image' OrderIso.isLUB_image'

@[simp]
theorem isGLB_image {s : Set α} {x : β} : IsGLB (f '' s) x ↔ IsGLB s (f.symm x) :=
  f.dual.isLUB_image
#align order_iso.is_glb_image OrderIso.isGLB_image

theorem isGLB_image' {s : Set α} {x : α} : IsGLB (f '' s) (f x) ↔ IsGLB s x :=
  f.dual.isLUB_image'
#align order_iso.is_glb_image' OrderIso.isGLB_image'

@[simp]
theorem isLUB_preimage {s : Set β} {x : α} : IsLUB (f ⁻¹' s) x ↔ IsLUB s (f x) := by
  rw [← f.symm_symm, ← image_eq_preimage, isLUB_image]
#align order_iso.is_lub_preimage OrderIso.isLUB_preimage

theorem isLUB_preimage' {s : Set β} {x : β} : IsLUB (f ⁻¹' s) (f.symm x) ↔ IsLUB s x := by
  rw [isLUB_preimage, f.apply_symm_apply]
#align order_iso.is_lub_preimage' OrderIso.isLUB_preimage'

@[simp]
theorem isGLB_preimage {s : Set β} {x : α} : IsGLB (f ⁻¹' s) x ↔ IsGLB s (f x) :=
  f.dual.isLUB_preimage
#align order_iso.is_glb_preimage OrderIso.isGLB_preimage

theorem isGLB_preimage' {s : Set β} {x : β} : IsGLB (f ⁻¹' s) (f.symm x) ↔ IsGLB s x :=
  f.dual.isLUB_preimage'
#align order_iso.is_glb_preimage' OrderIso.isGLB_preimage'

end OrderIso


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import algebra.category.Module.epi_mono
import category_theory.limits.concrete_category

/-!
# The concrete (co)kernels in the category of modules are (co)kernels in the categorical sense.
-/

open category_theory
open category_theory.limits

universes u v

namespace Module
variables {R : Type u} [ring R]

section
variables {M N : Module.{v} R} (f : M ⟶ N)

/-- The kernel cone induced by the concrete kernel. -/
def kernel_cone : kernel_fork f :=
kernel_fork.of_ι (as_hom f.ker.subtype) $ by tidy

/-- The kernel of a linear map is a kernel in the categorical sense. -/
def kernel_is_limit : is_limit (kernel_cone f) :=
fork.is_limit.mk _
  (λ s, linear_map.cod_restrict f.ker (fork.ι s) (λ c, linear_map.mem_ker.2 $
    by { rw [←@function.comp_apply _ _ _ f (fork.ι s) c, ←coe_comp, fork.condition,
      has_zero_morphisms.comp_zero (fork.ι s) N], refl }))
  (λ s, linear_map.subtype_comp_cod_restrict _ _ _)
  (λ s m h, linear_map.ext $ λ x, subtype.ext_iff_val.2 (by simpa [←h]))

/-- The cokernel cocone induced by the projection onto the quotient. -/
def cokernel_cocone : cokernel_cofork f :=
cokernel_cofork.of_π (as_hom f.range.mkq) $ linear_map.range_mkq_comp _

/-- The projection onto the quotient is a cokernel in the categorical sense. -/
def cokernel_is_colimit : is_colimit (cokernel_cocone f) :=
cofork.is_colimit.mk _
  (λ s, f.range.liftq (cofork.π s) $ linear_map.range_le_ker_iff.2 $ cokernel_cofork.condition s)
  (λ s, f.range.liftq_mkq (cofork.π s) _)
  (λ s m h,
  begin
    haveI : epi (as_hom f.range.mkq) := (epi_iff_range_eq_top _).mpr (submodule.range_mkq _),
    apply (cancel_epi (as_hom f.range.mkq)).1,
    convert h,
    exact submodule.liftq_mkq _ _ _
  end)
end

/-- The category of R-modules has kernels, given by the inclusion of the kernel submodule. -/
lemma has_kernels_Module : has_kernels (Module R) :=
⟨λ X Y f, has_limit.mk ⟨_, kernel_is_limit f⟩⟩

/-- The category or R-modules has cokernels, given by the projection onto the quotient. -/
lemma has_cokernels_Module : has_cokernels (Module R) :=
⟨λ X Y f, has_colimit.mk ⟨_, cokernel_is_colimit f⟩⟩

open_locale Module

local attribute [instance] has_kernels_Module
local attribute [instance] has_cokernels_Module

variables {G H : Module.{v} R} (f : G ⟶ H)

/--
The categorical kernel of a morphism in `Module`
agrees with the usual module-theoretical kernel.
-/
noncomputable def kernel_iso_ker {G H : Module.{v} R} (f : G ⟶ H) :
  kernel f ≅ Module.of R (f.ker) :=
limit.iso_limit_cone ⟨_, kernel_is_limit f⟩

-- We now show this isomorphism commutes with the inclusion of the kernel into the source.

@[simp, elementwise] lemma kernel_iso_ker_inv_kernel_ι :
  (kernel_iso_ker f).inv ≫ kernel.ι f = f.ker.subtype :=
limit.iso_limit_cone_inv_π _ _

@[simp, elementwise] lemma kernel_iso_ker_hom_ker_subtype :
  (kernel_iso_ker f).hom ≫ f.ker.subtype = kernel.ι f :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ (limit.is_limit _) walking_parallel_pair.zero

/--
The categorical cokernel of a morphism in `Module`
agrees with the usual module-theoretical quotient.
-/
noncomputable def cokernel_iso_range_quotient {G H : Module.{v} R} (f : G ⟶ H) :
  cokernel f ≅ Module.of R (H ⧸ f.range) :=
colimit.iso_colimit_cocone ⟨_, cokernel_is_colimit f⟩

-- We now show this isomorphism commutes with the projection of target to the cokernel.

@[simp, elementwise] lemma cokernel_π_cokernel_iso_range_quotient_hom :
  cokernel.π f ≫ (cokernel_iso_range_quotient f).hom = f.range.mkq :=
by { convert colimit.iso_colimit_cocone_ι_hom _ _; refl, }

@[simp, elementwise] lemma range_mkq_cokernel_iso_range_quotient_inv :
  ↿f.range.mkq ≫ (cokernel_iso_range_quotient f).inv = cokernel.π f :=
by { convert colimit.iso_colimit_cocone_ι_inv ⟨_, cokernel_is_colimit f⟩ _; refl, }

lemma cokernel_π_ext {M N : Module.{u} R} (f : M ⟶ N) {x y : N} (m : M) (w : x = y + f m) :
  cokernel.π f x = cokernel.π f y :=
by { subst w, simp, }

end Module


import algebra.ring
import order.boolean_algebra

universe u

variable (α : Type u)

class boolean_ring (α : Type u) extends (ring α) :=
(mul_self : ∀ a : α, a * a = a)

namespace boolean_ring

variable {α}
variables [boolean_ring α]

lemma add_self (a : α) : a + a = 0 :=
begin
  have := mul_self (a + a),
  rw [add_mul, mul_add, mul_self a] at this,
  exact calc
    a + a = (a + a) + (a + a) - (a + a) : (add_sub_cancel _ _).symm
    ... = 0 : by rw [this, sub_self]
end

lemma neg_self (a : α) : - a = a :=
 (eq_neg_iff_add_eq_zero.mpr (add_self a)).symm

instance : comm_ring α :=
{ mul_comm := λ a b,
  begin
    have h0 := mul_self (a + b),
    rw [mul_add, add_mul, add_mul, mul_self a, mul_self b, add_assoc] at h0,
    have h1 := congr_arg (has_add.add (b * a)) (add_left_cancel h0),
    rw [← add_assoc, add_self (b * a), zero_add] at h1,
    exact add_right_cancel h1
  end,
  .. (by {apply_instance} : ring α) }

open lattice

instance : has_le  α := ⟨λ a b, a * b = a⟩
instance : has_bot α := ⟨0⟩
instance : has_top α := ⟨1⟩
instance : has_sup α := ⟨λ a b, a + b + a * b⟩
instance : has_inf α := ⟨λ a b, a * b⟩

instance : boolean_algebra α :=
{ le := has_le.le,
  bot := has_bot.bot,
  top := has_top.top,
  sup := has_sup.sup,
  inf := has_inf.inf,
  le_refl := λ a, mul_self a,
  le_antisymm := λ a b (hab : a * b = a) (hba : b * a = b),
    (hab.symm.trans (mul_comm a b)).trans hba,
  le_trans := λ a b c (hab : a * b = a) (hbc : b * c = b),
    calc a * c = a * b * c : by {rw[hab],}
      ... = a : by {rw[mul_assoc,hbc,hab]},
  bot_le := λ a, (zero_mul a),
  le_top := λ a, (mul_one a),
  sup_le := λ a b c (hac : a * c = a) (hbc : b * c = b),
  show (a + b + a * b) * c = (a + b + a * b),
  by rw [add_mul, add_mul, mul_assoc, hac, hbc],
  le_sup_left := λ a b, show a * (a + b + a * b) = a,
  by rw [mul_add,mul_add,← mul_assoc,mul_self a,add_assoc,
         add_self (a * b),add_zero],
  le_sup_right := λ a b, show b * (a + b + a * b) = b,
  by rw[mul_comm a b,
        mul_add,mul_add,← mul_assoc,mul_self b,
        add_comm (b * a) b,add_assoc,
        add_self (b * a),add_zero],
  le_inf := λ a b c (hab : a * b = a) (hac : a * c = a),
  show a * (b * c) = a, by rw [← mul_assoc, hab, hac],
  inf_le_left := λ a b, show (a * b) * a = a * b,
  by rw [mul_assoc, mul_comm b a, ← mul_assoc, mul_self a],
  inf_le_right := λ a b, show (a * b) * b = a * b,
  by rw [mul_assoc,mul_self b],
  le_sup_inf := λ a b c, show
    (a + b + a * b) * (a + c + a * c) * (a + b * c + a * (b * c)) =
    (a + b + a * b) * (a + c + a * c),
  begin
    let ha := mul_self a,
    let hb := mul_self b,
    let hc := mul_self c,
    let u := (a + b + a * b),
    let v := (a + c + a * c),
    let w := (a + b * c + a * (b * c)),
    change u * v * w = u * v,
    have hua : u * a = a :=
    by {rw [mul_comm], dsimp[u],
        rw [mul_add, mul_add, ← mul_assoc, ha,
            add_assoc, add_self, add_zero] },
    have huc : u * c = a * c + b * c + a * b * c :=
    by {dsimp[u],rw[add_mul,add_mul]},
    have huv : u * v = a + b * c + b * c * a :=
    by {dsimp [v],
       rw [mul_add, mul_add, ← mul_assoc u, hua, add_assoc, add_comm (u * c)],
       rw [huc, ← add_assoc (a * c), ← add_assoc (a * c),
           add_self (a * c), zero_add],
       rw [add_assoc,mul_assoc a,mul_comm a]},
  have haw : a * w = a :=
    by {dsimp [w],
        rw [mul_add, mul_add, ← mul_assoc a, ← mul_assoc a, ← mul_assoc a],
        rw [ha, add_assoc, add_self, add_zero]},
  rw [huv, add_mul, add_mul, mul_assoc (b * c), haw],
  congr' 2,
  dsimp [w],
  rw [mul_add, mul_add, mul_comm a (b * c), ← mul_assoc (b * c) (b * c)],
  rw [mul_self (b * c), add_comm (b * c * a), add_assoc, add_self, add_zero],
 end,
 compl := λ a, 1 + a,
 sdiff := λ a b, a + a * b,
 sdiff_eq := λ a b, show a + a * b = a * (1 + b), by rw[mul_add,mul_one],
 sup_inf_sdiff := λ a b, show a * b + (a + a * b) + (a * b) * (a + a * b) = a,
  by rw[mul_add,mul_comm (a * b) a,← mul_assoc,mul_self a,mul_self (a * b),
     add_self (a * b),add_zero,add_comm a,← add_assoc,add_self (a * b),zero_add],
  inf_inf_sdiff := λ a b, show a * b * (a + a * b) = 0,
   by rw[mul_add,mul_self (a * b),mul_comm (a * b),← mul_assoc,mul_self a,
          add_self],
  inf_compl_le_bot := λ a, show a * (1 + a) * 0 = a * (1 + a),
   by rw[mul_zero,mul_add,mul_one,mul_self,add_self],
  top_le_sup_compl := λ a, show 1 * (a + (1 + a) + a * (1 + a)) = 1,
  by rw[one_mul,mul_add,mul_one,mul_self,add_self,add_zero,
           add_comm 1 a,← add_assoc,add_self,zero_add]
}

end boolean_ring


import basic_defs_world.level1 --hide
open set --hide
namespace topological_space --hide

/-
# Level 2: Union of two open sets
-/

/- Lemma
The union of two open sets is open.
-/
lemma open_of_union {X : Type} [topological_space X] {U V : set X}
(hU : is_open U) (hV : is_open V): is_open (U ∪ V) :=
begin
  let I : set (set X) := {U, V},
  have H : ⋃₀ I = U ∪ V := sUnion_pair U V,
  rw ←H,
  apply union,
  intros B hB,
  replace hB : B = U ∨ B = V, by tauto,
  cases hB; {rw hB, assumption},

end

end topological_space --hide


import tactic
import tactic.slim_check
import algebra.ordered_ring
universe u

-- 1.3. Properties of Ordered Domains

-- closest match to Birkhoff-Mac Lane "ordered domain is"
#check linear_ordered_comm_ring -- Mario Carneiro

-- Exercises for section 1.3

theorem ex_1_3_1_a (α: Type u) [linear_ordered_comm_ring α]
   (a b c : α) (h: a < b): a + c < b + c :=
  add_lt_add_right h c

theorem ex_1_3_1_b (α: Type u) [linear_ordered_comm_ring α]
   (a x y : α): a-x < a-y ↔ x > y := sub_lt_sub_iff_left a

lemma lt0_lt_flip (α: Type*) [linear_ordered_ring α] -- Ruben Van de Velde
   (a x : α) (hx: a * x < 0) (ha: a < 0) : 0 < x :=
  pos_of_mul_neg_right hx ha.le

theorem ex_1_3_1_c (α: Type u) [linear_ordered_comm_ring α]
   (a x y : α) (h: a < 0): a*x > a* y ↔ x < y :=
begin
  split,
  {
    intro h0,
    have h1 := sub_lt_zero.mpr h0,
    apply sub_lt_zero.1,
    rw ← mul_sub at h1,
    have h2 := lt0_lt_flip α a (y-x) h1 h,
    rw (neg_sub x y).symm at h2,
    exact neg_pos.1 h2,
  },
  {
    intro h0,
    apply sub_lt_zero.1,
    rw ← mul_sub,
    have h1 := sub_pos.2 h0,
    exact mul_neg_of_neg_of_pos h h1,
  }
end

theorem ex_1_3_1_d (α: Type u) [linear_ordered_comm_ring α]
   (a b c : α) (ha: 0 < c) (hacbc: a*c < b*c): a < b :=
  (mul_lt_mul_right ha).mp hacbc

theorem ex_1_3_1_e (α: Type u) [linear_ordered_comm_ring α]
   (x : α) (h: x + x + x + x = 0) : x = 0 :=
begin
  rw (add_assoc (x+x) x x) at h,
  exact bit0_eq_zero.mp (bit0_eq_zero.mp h),
end

lemma together  (α: Type u) [linear_ordered_comm_ring α] (a b: α) (h: a-b = 0)  : a = b :=
  sub_eq_zero.mp h

lemma factor_expr (α: Type u) [linear_ordered_comm_ring α] (a b : α) :
  a * (b ^ 2 * -3) + (a ^ 2 * (b * 3)) = 3*a*b*(a - b) :=
begin
  apply (together α (a * (b ^ 2 * -3) + (a ^ 2 * (b * 3))) (3*a*b*(a - b))),
  ring,
end

lemma move_cubes_left (α: Type u) [linear_ordered_comm_ring α]
   (a b : α) (h: 0 < a * (b ^ 2 * -3) + (a ^ 2 * (b * 3) + (-a ^ 3 + b ^ 3))) :
   a^3- b^3 < a * (b ^ 2 * -3) + (a ^ 2 * (b * 3)) :=
begin
  linarith,
end

lemma negneg (α: Type u) [linear_ordered_comm_ring α] (a b : α): a - b = - (b - a):=
begin
  linarith,
end

lemma this_is_negative (α: Type u) [linear_ordered_comm_ring α] (a b : α)
      (h1: 0 < b - a)
      (hha: a > 0)
      (hhb: b > 0) : 3 * a * b * (a - b) < 0 :=
begin
  rw negneg α a b,
  have h3 := zero_lt_three,
  have h4 := mul_pos h3 hha,
  have h5 := mul_pos h4 hhb,
  simp,
  have h6 := neg_lt_zero.mpr h1,
  have h7 := neg_sub b  a,
  rw h7 at h6,
  exact linarith.mul_neg h6 h5,
  exact nontrivial_of_lt 0 (b - a) h1,
end

lemma this_is_positive (α: Type u) [linear_ordered_comm_ring α] (a b : α)
      (h1: 0 < b - a) (hb: b > 0) (alt0: a < 0) : 0 < 3 * a * b * (a - b) :=
begin
  have h3 := zero_lt_three,
  have h4 := mul_neg_of_pos_of_neg h3 alt0,
  have h5 := mul_neg_of_neg_of_pos h4 hb,
  have h6 := neg_lt_zero.mpr h1,
  have h7 := mul_pos_of_neg_of_neg h5 h6,
  have h8 := neg_sub b a,
  rw h8 at h7,
  exact h7,
  exact nontrivial_of_lt 0 (b - a) h1,
end

lemma simp_pow (α: Type u) [linear_ordered_comm_ring α]: (0:α)^3 = 0 :=
  tactic.ring_exp.pow_p_pf_zero rfl rfl

lemma is_lt_0 (α: Type u) [linear_ordered_comm_ring α] (b : α)
      (hb: ¬b > 0) (hb0: ¬b = 0): b < 0 :=
  (ne.le_iff_lt hb0).mp (not_lt.mp hb)

lemma odd_pos_neg_neg (α: Type u) [linear_ordered_comm_ring α] (a : α)
        (h: a < 0) : a^3 < 0 :=
  pow_bit1_neg_iff.mpr h

lemma this_be_negative (α: Type u) [linear_ordered_comm_ring α] (a b : α)
      (h1: a < b)
      (halt0: a < 0)
      (hblt0: b < 0) :
      3 * a * b * (a - b) < 0 :=
begin
  have h3 := zero_lt_three,
  have h4 := sub_lt_zero.mpr h1,
  have h5 := mul_pos_of_neg_of_neg  halt0 hblt0,
  have h6 := mul_pos h3 h5,
  have h7 := sub_lt_zero.mpr h1,
  have h8 := linarith.mul_neg h7 h6,
  finish,
  exact nontrivial_of_lt a b h1,
end

theorem ex_1_3_1_f (α: Type u) [linear_ordered_comm_ring α]
   (a b : α) (h: a < b): a^3 < b^3 :=
begin
  have h1 := sub_pos.2 h,
  have h2 := pow_pos h1 3,
  repeat { rw pow_succ' at h2, },
  simp at h2,
  rw sub_eq_neg_add at h2,
  repeat { rw right_distrib at h2, rw left_distrib at h2, },
  ring_exp at h2,
  have h3 := move_cubes_left α a b h2,
  rw factor_expr α a b at h3,
  by_cases ha : a > 0,
  {
    by_cases hb : b > 0,
    {
      have h4 := this_is_negative α a b h1 ha hb,
      have h5 := lt_trans h3 h4,
      exact sub_lt_zero.1 h5,
    },
    {
      exfalso,
      exact hb (lt_trans ha h),
    },
  },
  by_cases ha0: a = 0,
  {
    rw ha0 at *,
    simp at *,
    assumption,
  },
  {
    have halt0 := is_lt_0 α a ha ha0,
    have h3alt0 := odd_pos_neg_neg α a halt0,
    by_cases hb : b > 0,
    {
      have h3bgt0 := pow_pos hb 3,
      exact lt_trans h3alt0 h3bgt0,
    },
    by_cases hb0 : b = 0,
    {
      rw hb0,
      rw simp_pow,
      assumption,
    },
    {
      have hblt0 := is_lt_0 α b hb hb0,
      have hf := this_be_negative α a b h halt0 hblt0,
      have hf1 := lt_trans h3 hf,
      finish,
    }
  }
end

-- 1.4. Well-Ordering Principle

-- Exercises for section 1.4

-- 1.5. Finite Induction; Laws of Exponents

-- Exercises for section 1.5

-- 1.6. Divisibility

-- Exercises for section 1.6

-- 1.7. The Euclidean Algorithm

-- Exercises for section 1.7

-- 1.8. Fundamental Theorem of Arithmetic

-- Exercises for section 1.8

-- 1.9. Congruences

-- Exercises for section 1.9

-- 1.10. The Rings ℤn

-- Exercises for section 1.10

-- 1.11. Sets, Functions, and Relations

-- Exercises for section 1.11

-- 1.12. Isomorphisms and Automorphisms

-- Exercises for section 1.12


/-
/-- `|{a : F // is_quad_residue a}| * 2 = |F| - 1` -/
theorem card_residues_mul_two_eq [decidable_eq F] (hp: p ≠ 2) :
fintype.card {a : F // is_quad_residue a} * 2 = q - 1 :=
by rwa [← card_units, card_units_eq_card_residues_mul_two F hp]
-/

/-
lemma residues_setcard_eq_fintype_card [decidable_eq F] :
set.card {a : F | is_quad_residue a} = fintype.card {a : F // is_quad_residue a} :=
set.to_finset_card {a : F | is_quad_residue a}

lemma non_residues_setcard_eq_fintype_card [decidable_eq F] :
set.card {a : F | is_non_residue a} = fintype.card {a : F // is_non_residue a} :=
set.to_finset_card {a : F | is_non_residue a}

lemma disjoint_residues_non_residues [decidable_eq F] :
disjoint {a : F | is_quad_residue a} {a : F | is_non_residue a} :=
begin
  simp [set.disjoint_iff_inter_eq_empty, is_non_residue, is_quad_residue],
  ext, simp,
  rintros h b rfl _,
  use b,
end

lemma residues_union_non_residues [decidable_eq F] :
{a : F | is_quad_residue a} ∪ {a : F | is_non_residue a} = {a : F | a ≠ 0} :=
begin
  ext,
  simp [is_non_residue, is_quad_residue, ←and_or_distrib_left],
  intros,
  convert or_not,
  simp,
end

lemma univ_setcard_split [decidable_eq F] :
(@set.univ F).card = {a : F | a ≠ 0}.card + ({0} : set F).card :=
set.card_disjoint_union' (disjoint_units_zero F) (units_union_zero F)

lemma zero_setcard_eq_one [decidable_eq F] : ({0} : set F).card = 1 :=
by simp [set.card]

lemma univ_setcard_eq_units_setcard_add_one [decidable_eq F] :
(@set.univ F).card = {a : F | a ≠ 0}.card + 1 :=
by rw [univ_setcard_split,zero_setcard_eq_one]

lemma units_setcard_split [decidable_eq F] :
{a : F | a ≠ 0}.card = {a : F | is_quad_residue a}.card + {a : F | is_non_residue a}.card  :=
set.card_disjoint_union' (disjoint_residues_non_residues F) (residues_union_non_residues F)

@[simp] lemma in_residues_sum_one_eq [decidable_eq F] :
∑ i in {a : F | is_quad_residue a}.to_finset, (1 : ℚ) = {a : F | is_quad_residue a}.card :=
by simp only [set.card, finset.card_eq_sum_ones_ℚ]

@[simp] lemma in_non_residues_sum_neg_one_eq [decidable_eq F] :
∑ i in {a : F | is_non_residue a}.to_finset, (-1 : ℚ) = - {a : F | is_non_residue a}.card :=
by simp only [set.card, finset.card_eq_sum_ones_ℚ, sum_neg_distrib]
-/

/-
variable {F}

/-- The cardinality of quadratic residues equals that of non-residues. -/
lemma card_residues_eq_card_non_residues_set [decidable_eq F] (hp : p ≠ 2):
{a : F | is_quad_residue a}.card = {a : F | is_non_residue a}.card :=
begin
  have h:= card_residues_mul_two_eq F hp,
  rw [card_eq_set_card_of_univ F, ←residues_setcard_eq_fintype_card,
      univ_setcard_eq_units_setcard_add_one,  units_setcard_split] at h,
  simp [mul_two, *] at *,
end

/-- `fintype` version of `finite_field.card_residues_eq_card_non_residues_set` . -/
lemma card_residues_eq_card_non_residues_subtpye [decidable_eq F] (hp : p ≠ 2):
fintype.card {a : F // is_quad_residue a} = fintype.card {a : F // is_non_residue a} :=
by rwa [←residues_setcard_eq_fintype_card, ←non_residues_setcard_eq_fintype_card,
        card_residues_eq_card_non_residues_set hp]

-/

/-
lemma quad_char.sum_in_units_eq_zero (hp : p ≠ 2):
∑ (b : F) in univ.filter (λ b, b ≠ (0 : F)), χ b = 0 :=
begin
  rw [finset.sum_split _ (λ b : F, is_quad_residue b)],
  have h1 : ∑ (j : F) in filter (λ (b : F), is_quad_residue b) (filter (λ (b : F), b ≠ 0) univ), χ j =
            ∑ (j : F) in {a : F | is_quad_residue a}.to_finset, 1,
  { apply finset.sum_congr,
    {ext, split, all_goals {intro h, simp* at *}, use h.1},
    intros x hx,
    simp* at * },
  have h2 : ∑ (j : F) in filter (λ (x : F), ¬is_quad_residue x) (filter (λ (b : F), b ≠ 0) univ), χ j =
            ∑ (j : F) in {a : F | is_non_residue a}.to_finset, -1,
  { apply finset.sum_congr,
    {ext, split, all_goals {intro h, simp [*, is_non_residue, is_quad_residue] at *}},
    intros x hx,
    simp* at * },
  simp at h1 h2,
  simp [h1, h2],
end

-/

/-
/-- helper of `quad_char.sum_mul'`: reindex the terms in the summation -/
lemma quad_char.sum_mul'_aux {c : F} (hc : c ≠ 0) :
∑ (b : F) in filter (λ (b : F), ¬b = 0) univ, χ (b⁻¹ * (b + c)) =
∑ (z : F) in filter (λ (z : F), ¬z = 1) univ, χ (z) :=
begin
  refine finset.sum_bij
  (λ b hb, b⁻¹ * (b + c)) (λ b hb, _) (λ b hb, rfl) (λ b₁ b₂ h1 h2 h, _) (λ z hz, _),
  { simp at hb, simp [*, mul_add] at * },
  { simp at h1 h2, rw mul_add at h, rw mul_add at h, simp* at h, assumption},
  { use c * (z - 1)⁻¹, simp, simp at hz, push_neg, refine ⟨⟨hc, sub_ne_zero.mpr hz⟩, _⟩,
    simp [*, mul_inv_rev', mul_add, mul_assoc, sub_ne_zero.mpr hz] }
end
-/

/-
theorem quad_char.sum_mul' {c : F} (hc : c ≠ 0) (hp : p ≠ 2):
∑ b : F, χ (b) * χ (b + c) = -1 :=
begin
  rw [finset.sum_split _ (λ b, b ≠ (0 : F))],
  simp,
  have h: ∑ (b : F) in filter (λ (b : F), ¬b = 0) univ, χ b * χ (b + c) =
          ∑ (b : F) in filter (λ (b : F), ¬b = 0) univ, χ b * χ b * χ (b⁻¹ * (b + c)),
  { apply finset.sum_congr rfl,
    intros b hb, simp at hb,
    have : b * b * (b⁻¹ * (b + c)) = b * (b + c), {field_simp, ring},
    repeat {rw ←(quad_char_mul hp)}, rw ← this,
    all_goals {assumption} },
  have h': ∑ (b : F) in filter (λ (b : F), ¬b = 0) univ, χ b * χ b * χ (b⁻¹ * (b + c)) =
           ∑ (b : F) in filter (λ (b : F), ¬b = 0) univ, χ (b⁻¹ * (b + c)),
  { apply finset.sum_congr rfl, intros b hb, simp* at *},
  rw [h, h', quad_char.sum_mul'_aux hc],
  have g:= @finset.sum_split _ _ _ (@finset.univ F _) (χ) (λ b : F, b ≠ (1 : F)) _,
  simp [quad_char.sum_eq_zero F hp] at g,
  rw [← sub_zero (∑ (z : F) in filter (λ (b : F), ¬b = 1) univ, χ z), g],
  ring,
end
-/

/-
Can keep this.

variables (F)

/-- The subtype of `F` containing quadratic residues. -/
def quad_residues := {a : F // is_quad_residue a}
/-- The set containing quadratic residues of `F`. -/
def quad_residues_set [decidable_eq F] := {a : F | is_quad_residue a}

/-- The subtype of `F` containing quadratic non-residues. -/
def non_residues := {a : F // is_non_residue a}
/-- The set containing quadratic non-residues of `F`. -/
def non_residues_set [decidable_eq F] := {a : F | is_non_residue a}

instance [decidable_eq F] : fintype (quad_residues F) :=
by {unfold quad_residues, apply_instance}

instance [decidable_eq F] : fintype (non_residues F) :=
by {unfold non_residues, apply_instance}

-/


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite
import data.fintype.big_operators

/-!
# Intervals in a pi type

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

This file shows that (dependent) functions to locally finite orders equipped with the pointwise
order are locally finite and calculates the cardinality of their intervals.
-/

open finset fintype
open_locale big_operators

variables {ι : Type*} {α : ι → Type*}

namespace pi

section locally_finite
variables [decidable_eq ι] [fintype ι] [Π i, decidable_eq (α i)]
  [Π i, partial_order (α i)] [Π i, locally_finite_order (α i)]

instance : locally_finite_order (Π i, α i) :=
locally_finite_order.of_Icc _
  (λ a b, pi_finset $ λ i, Icc (a i) (b i))
  (λ a b x, by simp_rw [mem_pi_finset, mem_Icc, le_def, forall_and_distrib])

variables (a b : Π i, α i)

lemma Icc_eq : Icc a b = pi_finset (λ i, Icc (a i) (b i)) := rfl

lemma card_Icc : (Icc a b).card = ∏ i, (Icc (a i) (b i)).card := card_pi_finset _

lemma card_Ico : (Ico a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 :=
by rw [card_Ico_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioc : (Ioc a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 :=
by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioo : (Ioo a b).card = (∏ i, (Icc (a i) (b i)).card) - 2 :=
by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc]

end locally_finite

section bounded
variables [decidable_eq ι] [fintype ι] [Π i, decidable_eq (α i)] [Π i, partial_order (α i)]

section bot
variables [Π i, locally_finite_order_bot (α i)] (b : Π i, α i)

instance : locally_finite_order_bot (Π i, α i) :=
locally_finite_order_top.of_Iic _
  (λ b, pi_finset $ λ i, Iic (b i))
  (λ b x, by simp_rw [mem_pi_finset, mem_Iic, le_def])

lemma card_Iic : (Iic b).card = ∏ i, (Iic (b i)).card := card_pi_finset _

lemma card_Iio : (Iio b).card = (∏ i, (Iic (b i)).card) - 1 :=
by rw [card_Iio_eq_card_Iic_sub_one, card_Iic]

end bot

section top
variables [Π i, locally_finite_order_top (α i)] (a : Π i, α i)

instance : locally_finite_order_top (Π i, α i) :=
locally_finite_order_top.of_Ici _
  (λ a, pi_finset $ λ i, Ici (a i))
  (λ a x, by simp_rw [mem_pi_finset, mem_Ici, le_def])

lemma card_Ici : (Ici a).card = (∏ i, (Ici (a i)).card) := card_pi_finset _

lemma card_Ioi : (Ioi a).card = (∏ i, (Ici (a i)).card) - 1 :=
by rw [card_Ioi_eq_card_Ici_sub_one, card_Ici]

end top

end bounded

end pi


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import set_theory.ordinal_arithmetic

/-!
### Principal ordinals

We define principal or indecomposable ordinals, and we prove the standard properties about them.

### Todo
* Prove the characterization of additive principal ordinals.
* Prove the characterization of multiplicative principal ordinals.
* Refactor any related theorems from `ordinal_arithmetic` into this file.
-/

universe u

noncomputable theory

namespace ordinal

/-! ### Principal ordinals -/

/-- An ordinal `o` is said to be principal or indecomposable under an operation when the set of
ordinals less than it is closed under that operation. In standard mathematical usage, this term is
almost exclusively used for additive and multiplicative principal ordinals.

For simplicity, we break usual convention and regard 0 as principal. -/
def principal (op : ordinal → ordinal → ordinal) (o : ordinal) : Prop :=
∀ ⦃a b⦄, a < o → b < o → op a b < o

theorem principal_iff_principal_swap {op : ordinal → ordinal → ordinal} {o : ordinal} :
  principal op o ↔ principal (function.swap op) o :=
by split; exact λ h a b ha hb, h hb ha

theorem principal_zero {op : ordinal → ordinal → ordinal} : principal op 0 :=
λ a _ h, (ordinal.not_lt_zero a h).elim

@[simp] theorem principal_one_iff {op : ordinal → ordinal → ordinal} :
  principal op 1 ↔ op 0 0 = 0 :=
begin
  refine ⟨λ h, _, λ h a b ha hb, _⟩,
  { rwa ←lt_one_iff_zero,
    exact h zero_lt_one zero_lt_one },
  { rwa [lt_one_iff_zero, ha, hb] at * }
end

theorem principal.iterate_lt {op : ordinal → ordinal → ordinal} {a o : ordinal} (hao : a < o)
  (ho : principal op o) (n : ℕ) : (op a)^[n] a < o :=
begin
  induction n with n hn,
  { rwa function.iterate_zero },
  { rw function.iterate_succ', exact ho hao hn }
end

theorem op_eq_self_of_principal {op : ordinal → ordinal → ordinal} {a o : ordinal.{u}}
  (hao : a < o) (H : is_normal (op a)) (ho : principal op o) (ho' : is_limit o) : op a o = o :=
begin
  refine le_antisymm _ (H.le_self _),
  rw [←is_normal.bsup_eq.{u u} H ho', bsup_le],
  exact λ b hbo, le_of_lt (ho hao hbo)
end

theorem nfp_le_of_principal {op : ordinal → ordinal → ordinal}
  {a o : ordinal} (hao : a < o) (ho : principal op o) : nfp (op a) a ≤ o :=
nfp_le.2 $ λ n, le_of_lt (ho.iterate_lt hao n)

/-! ### Principal ordinals are unbounded -/

/-- The least strict upper bound of `op` applied to all pairs of ordinals less than `o`. This is
essentially a two-argument version of `ordinal.blsub`. -/
def blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) : ordinal :=
lsub (λ x : o.out.α × o.out.α, op (typein o.out.r x.1) (typein o.out.r x.2))

theorem lt_blsub₂ (op : ordinal → ordinal → ordinal) {o : ordinal} {a b : ordinal} (ha : a < o)
  (hb : b < o) : op a b < blsub₂ op o :=
begin
  convert lt_lsub _ (prod.mk (enum o.out.r a (by rwa type_out)) (enum o.out.r b (by rwa type_out))),
  simp only [typein_enum]
end

theorem principal_nfp_blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) :
  principal op (nfp (blsub₂.{u u} op) o) :=
begin
  intros a b ha hb,
  rw lt_nfp at *,
  cases ha with m hm,
  cases hb with n hn,
  cases le_total ((blsub₂.{u u} op)^[m] o) ((blsub₂.{u u} op)^[n] o) with h h,
  { use n + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op (hm.trans_le h) hn },
  { use m + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op hm (hn.trans_le h) },
end

theorem unbounded_principal (op : ordinal → ordinal → ordinal) :
  set.unbounded (<) {o | principal op o} :=
λ o, ⟨_, principal_nfp_blsub₂ op o, (le_nfp_self _ o).not_lt⟩

end ordinal


import data.set.function

open set

universes u v
variable {α : Type u}
variable {β : Type v}
variable (f : α → β)
variable (s : set α)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que f es inyectiva sobre s syss
--    ∀ {x₁ x₂}, x₁ ∈ s → x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂
-- ----------------------------------------------------------------------

example :
  inj_on f s ↔
  ∀ ⦃x₁ : α⦄, x₁ ∈ s → ∀ ⦃x₂ : α⦄, x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂ :=
iff.rfl


theorem tst1 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intros h1 h2 h3;
  revert h2;
  intro h2;
  exact Eq.trans h3 h1
}

theorem tst2 (x y z : Nat) : y = z → x = x → x = y → x = z :=
by {
  intros h1 h2 h3;
  revert y;
  intros y hb ha;
  exact Eq.trans ha hb
}

theorem tst3 (x y z : Nat) : y = z → x = x → x = y → x = z := by
  intros
  revert ‹x = y›
  intro ha
  exact Eq.trans ha ‹y = z›


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

/-!
# Implicit function theorem

We prove three versions of the implicit function theorem. First we define a structure
`implicit_function_data` that holds arguments for the most general version of the implicit function
theorem, see `implicit_function_data.implicit_function`
and `implicit_function_data.to_implicit_function`. This version allows a user to choose
a specific implicit function but provides only a little convenience over the inverse function
theorem.

Then we define `implicit_function_of_complemented`: implicit function defined by `f (g z y) = z`,
where `f : E → F` is a function strictly differentiable at `a` such that its derivative `f'`
is surjective and has a `complemented` kernel.

Finally, if the codomain of `f` is a finite dimensional space, then we can automatically prove
that the kernel of `f'` is complemented, hence the only assumptions are `has_strict_fderiv_at`
and `f'.range = ⊤`. This version is named `implicit_function`.

## TODO

* Add a version for a function `f : E × F → G` such that $$\frac{\partial f}{\partial y}$$ is
  invertible.
* Add a version for `f : 𝕜 × 𝕜 → 𝕜` proving `has_strict_deriv_at` and `deriv φ = ...`.
* Prove that in a real vector space the implicit function has the same smoothness as the original
  one.
* If the original function is differentiable in a neighborhood, then the implicit function is
  differentiable in a neighborhood as well. Current setup only proves differentiability at one
  point for the implicit function constructed in this file (as opposed to an unspecified implicit
  function). One of the ways to overcome this difficulty is to use uniqueness of the implicit
  function in the general version of the theorem. Another way is to prove that *any* implicit
  function satisfying some predicate is strictly differentiable.

## Tags

implicit function, inverse function
-/

noncomputable theory

open_locale topology
open filter
open continuous_linear_map (fst snd smul_right ker_prod)
open continuous_linear_equiv (of_bijective)
open linear_map (ker range)

/-!
### General version

Consider two functions `f : E → F` and `g : E → G` and a point `a` such that

* both functions are strictly differentiable at `a`;
* the derivatives are surjective;
* the kernels of the derivatives are complementary subspaces of `E`.

Note that the map `x ↦ (f x, g x)` has a bijective derivative, hence it is a local homeomorphism
between `E` and `F × G`. We use this fact to define a function `φ : F → G → E`
(see `implicit_function_data.implicit_function`) such that for `(y, z)` close enough to `(f a, g a)`
we have `f (φ y z) = y` and `g (φ y z) = z`.

We also prove a formula for $$\frac{\partial\varphi}{\partial z}.$$

Though this statement is almost symmetric with respect to `F`, `G`, we interpret it in the following
way. Consider a family of surfaces `{x | f x = y}`, `y ∈ 𝓝 (f a)`. Each of these surfaces is
parametrized by `φ y`.

There are many ways to choose a (differentiable) function `φ` such that `f (φ y z) = y` but the
extra condition `g (φ y z) = z` allows a user to select one of these functions. If we imagine
that the level surfaces `f = const` form a local horizontal foliation, then the choice of
`g` fixes a transverse foliation `g = const`, and `φ` is the inverse function of the projection
of `{x | f x = y}` along this transverse foliation.

This version of the theorem is used to prove the other versions and can be used if a user
needs to have a complete control over the choice of the implicit function.
-/

/-- Data for the general version of the implicit function theorem. It holds two functions
`f : E → F` and `g : E → G` (named `left_fun` and `right_fun`) and a point `a` (named `pt`)
such that

* both functions are strictly differentiable at `a`;
* the derivatives are surjective;
* the kernels of the derivatives are complementary subspaces of `E`. -/
@[nolint has_nonempty_instance]
structure implicit_function_data (𝕜 : Type*) [nontrivially_normed_field 𝕜]
  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E]
  (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F]
  (G : Type*) [normed_add_comm_group G] [normed_space 𝕜 G] [complete_space G] :=
(left_fun : E → F)
(left_deriv : E →L[𝕜] F)
(right_fun : E → G)
(right_deriv : E →L[𝕜] G)
(pt : E)
(left_has_deriv : has_strict_fderiv_at left_fun left_deriv pt)
(right_has_deriv : has_strict_fderiv_at right_fun right_deriv pt)
(left_range : range left_deriv = ⊤)
(right_range : range right_deriv = ⊤)
(is_compl_ker : is_compl (ker left_deriv) (ker right_deriv))

namespace implicit_function_data

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F]
  {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] [complete_space G]
  (φ : implicit_function_data 𝕜 E F G)

/-- The function given by `x ↦ (left_fun x, right_fun x)`. -/
def prod_fun (x : E) : F × G := (φ.left_fun x, φ.right_fun x)

@[simp] lemma prod_fun_apply (x : E) : φ.prod_fun x = (φ.left_fun x, φ.right_fun x) := rfl

protected lemma has_strict_fderiv_at :
  has_strict_fderiv_at φ.prod_fun
    (φ.left_deriv.equiv_prod_of_surjective_of_is_compl φ.right_deriv φ.left_range φ.right_range
       φ.is_compl_ker : E →L[𝕜] F × G) φ.pt :=
φ.left_has_deriv.prod φ.right_has_deriv

/-- Implicit function theorem. If `f : E → F` and `g : E → G` are two maps strictly differentiable
at `a`, their derivatives `f'`, `g'` are surjective, and the kernels of these derivatives are
complementary subspaces of `E`, then `x ↦ (f x, g x)` defines a local homeomorphism between
`E` and `F × G`. In particular, `{x | f x = f a}` is locally homeomorphic to `G`. -/
def to_local_homeomorph : local_homeomorph E (F × G) :=
φ.has_strict_fderiv_at.to_local_homeomorph _

/-- Implicit function theorem. If `f : E → F` and `g : E → G` are two maps strictly differentiable
at `a`, their derivatives `f'`, `g'` are surjective, and the kernels of these derivatives are
complementary subspaces of `E`, then `implicit_function_of_is_compl_ker` is the unique (germ of a)
map `φ : F → G → E` such that `f (φ y z) = y` and `g (φ y z) = z`. -/
def implicit_function : F → G → E := function.curry $ φ.to_local_homeomorph.symm

@[simp] lemma to_local_homeomorph_coe : ⇑(φ.to_local_homeomorph) = φ.prod_fun := rfl

lemma to_local_homeomorph_apply (x : E) :
  φ.to_local_homeomorph x = (φ.left_fun x, φ.right_fun x) :=
rfl

lemma pt_mem_to_local_homeomorph_source :
  φ.pt ∈ φ.to_local_homeomorph.source :=
φ.has_strict_fderiv_at.mem_to_local_homeomorph_source

lemma map_pt_mem_to_local_homeomorph_target :
  (φ.left_fun φ.pt, φ.right_fun φ.pt) ∈ φ.to_local_homeomorph.target :=
φ.to_local_homeomorph.map_source $ φ.pt_mem_to_local_homeomorph_source

lemma prod_map_implicit_function :
  ∀ᶠ (p : F × G) in 𝓝 (φ.prod_fun φ.pt), φ.prod_fun (φ.implicit_function p.1 p.2) = p :=
φ.has_strict_fderiv_at.eventually_right_inverse.mono $ λ ⟨z, y⟩ h, h

lemma left_map_implicit_function :
  ∀ᶠ (p : F × G) in 𝓝 (φ.prod_fun φ.pt), φ.left_fun (φ.implicit_function p.1 p.2) = p.1 :=
φ.prod_map_implicit_function.mono $ λ z, congr_arg prod.fst

lemma right_map_implicit_function :
  ∀ᶠ (p : F × G) in 𝓝 (φ.prod_fun φ.pt), φ.right_fun (φ.implicit_function p.1 p.2) = p.2 :=
φ.prod_map_implicit_function.mono $ λ z, congr_arg prod.snd

lemma implicit_function_apply_image :
  ∀ᶠ x in 𝓝 φ.pt, φ.implicit_function (φ.left_fun x) (φ.right_fun x) = x :=
φ.has_strict_fderiv_at.eventually_left_inverse

lemma map_nhds_eq : map φ.left_fun (𝓝 φ.pt) = 𝓝 (φ.left_fun φ.pt) :=
show map (prod.fst ∘ φ.prod_fun) (𝓝 φ.pt) = 𝓝 (φ.prod_fun φ.pt).1,
by rw [← map_map, φ.has_strict_fderiv_at.map_nhds_eq_of_equiv, map_fst_nhds]

lemma implicit_function_has_strict_fderiv_at
  (g'inv : G →L[𝕜] E) (hg'inv : φ.right_deriv.comp g'inv = continuous_linear_map.id 𝕜 G)
  (hg'invf : φ.left_deriv.comp g'inv = 0) :
  has_strict_fderiv_at (φ.implicit_function (φ.left_fun φ.pt)) g'inv (φ.right_fun φ.pt) :=
begin
  have := φ.has_strict_fderiv_at.to_local_inverse,
  simp only [prod_fun] at this,
  convert this.comp (φ.right_fun φ.pt)
    ((has_strict_fderiv_at_const _ _).prod (has_strict_fderiv_at_id _)),
  simp only [continuous_linear_map.ext_iff, continuous_linear_map.coe_comp', function.comp_app]
    at hg'inv hg'invf ⊢,
  simp [continuous_linear_equiv.eq_symm_apply, *]
end

end implicit_function_data

namespace has_strict_fderiv_at

section complemented

/-!
### Case of a complemented kernel

In this section we prove the following version of the implicit function theorem. Consider a map
`f : E → F` and a point `a : E` such that `f` is strictly differentiable at `a`, its derivative `f'`
is surjective and the kernel of `f'` is a complemented subspace of `E` (i.e., it has a closed
complementary subspace). Then there exists a function `φ : F → ker f' → E` such that for `(y, z)`
close to `(f a, 0)` we have `f (φ y z) = y` and the derivative of `φ (f a)` at zero is the
embedding `ker f' → E`.

Note that a map with these properties is not unique. E.g., different choices of a subspace
complementary to `ker f'` lead to different maps `φ`.
-/

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F]
  {f : E → F} {f' : E →L[𝕜] F} {a : E}

section defs

variables (f f')

/-- Data used to apply the generic implicit function theorem to the case of a strictly
differentiable map such that its derivative is surjective and has a complemented kernel. -/
@[simp] def implicit_function_data_of_complemented (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  implicit_function_data 𝕜 E F (ker f') :=
{ left_fun := f,
  left_deriv := f',
  right_fun := λ x, classical.some hker (x - a),
  right_deriv := classical.some hker,
  pt := a,
  left_has_deriv := hf,
  right_has_deriv := (classical.some hker).has_strict_fderiv_at.comp a
    ((has_strict_fderiv_at_id a).sub_const a),
  left_range := hf',
  right_range := linear_map.range_eq_of_proj (classical.some_spec hker),
  is_compl_ker := linear_map.is_compl_of_proj (classical.some_spec hker) }

/-- A local homeomorphism between `E` and `F × f'.ker` sending level surfaces of `f`
to vertical subspaces. -/
def implicit_to_local_homeomorph_of_complemented (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  local_homeomorph E (F × (ker f')) :=
(implicit_function_data_of_complemented f f' hf hf' hker).to_local_homeomorph

/-- Implicit function `g` defined by `f (g z y) = z`. -/
def implicit_function_of_complemented (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  F → (ker f') → E :=
(implicit_function_data_of_complemented f f' hf hf' hker).implicit_function

end defs

@[simp] lemma implicit_to_local_homeomorph_of_complemented_fst (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) (x : E) :
  (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker x).fst = f x :=
rfl

lemma implicit_to_local_homeomorph_of_complemented_apply
  (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤)
  (hker : (ker f').closed_complemented) (y : E) :
  hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker y =
    (f y, classical.some hker (y - a)) :=
rfl

@[simp] lemma implicit_to_local_homeomorph_of_complemented_apply_ker
  (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤)
  (hker : (ker f').closed_complemented) (y : ker f') :
  hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker (y + a) = (f (y + a), y) :=
by simp only [implicit_to_local_homeomorph_of_complemented_apply, add_sub_cancel,
  classical.some_spec hker]

@[simp] lemma implicit_to_local_homeomorph_of_complemented_self
  (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker a = (f a, 0) :=
by simp [hf.implicit_to_local_homeomorph_of_complemented_apply]

lemma mem_implicit_to_local_homeomorph_of_complemented_source (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  a ∈ (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).source :=
mem_to_local_homeomorph_source _

lemma mem_implicit_to_local_homeomorph_of_complemented_target (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  (f a, (0 : ker f')) ∈ (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).target :=
by simpa only [implicit_to_local_homeomorph_of_complemented_self] using
  ((hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).map_source $
    (hf.mem_implicit_to_local_homeomorph_of_complemented_source hf' hker))

/-- `implicit_function_of_complemented` sends `(z, y)` to a point in `f ⁻¹' z`. -/
lemma map_implicit_function_of_complemented_eq (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  ∀ᶠ (p : F × (ker f')) in 𝓝 (f a, 0),
    f (hf.implicit_function_of_complemented f f' hf' hker p.1 p.2) = p.1 :=
((hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).eventually_right_inverse $
  hf.mem_implicit_to_local_homeomorph_of_complemented_target hf' hker).mono $ λ ⟨z, y⟩ h,
    congr_arg prod.fst h

/-- Any point in some neighborhood of `a` can be represented as `implicit_function`
of some point. -/

@[simp] lemma implicit_function_of_complemented_apply_image (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  hf.implicit_function_of_complemented f f' hf' hker (f a) 0 = a :=
begin
  convert (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).left_inv
    (hf.mem_implicit_to_local_homeomorph_of_complemented_source hf' hker),
  exact congr_arg prod.snd (hf.implicit_to_local_homeomorph_of_complemented_self hf' hker).symm
end

lemma to_implicit_function_of_complemented (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) :
  has_strict_fderiv_at (hf.implicit_function_of_complemented f f' hf' hker (f a))
    (ker f').subtypeL 0 :=
begin
  convert (implicit_function_data_of_complemented f f' hf hf'
    hker).implicit_function_has_strict_fderiv_at (ker f').subtypeL _ _,
  swap,
  { ext, simp only [classical.some_spec hker, implicit_function_data_of_complemented,
                    continuous_linear_map.coe_comp', submodule.coe_subtypeL', submodule.coe_subtype,
                    function.comp_app, continuous_linear_map.coe_id', id.def] },
  swap,
  { ext, simp only [continuous_linear_map.coe_comp', submodule.coe_subtypeL', submodule.coe_subtype,
                    function.comp_app, linear_map.map_coe_ker, continuous_linear_map.zero_apply] },
  simp only [implicit_function_data_of_complemented, map_sub, sub_self],
end

end complemented

/-!
### Finite dimensional case

In this section we prove the following version of the implicit function theorem. Consider a map
`f : E → F` from a Banach normed space to a finite dimensional space.
Take a point `a : E` such that `f` is strictly differentiable at `a` and its derivative `f'`
is surjective. Then there exists a function `φ : F → ker f' → E` such that for `(y, z)`
close to `(f a, 0)` we have `f (φ y z) = y` and the derivative of `φ (f a)` at zero is the
embedding `ker f' → E`.

This version deduces that `ker f'` is a complemented subspace from the fact that `F` is a finite
dimensional space, then applies the previous version.

Note that a map with these properties is not unique. E.g., different choices of a subspace
complementary to `ker f'` lead to different maps `φ`.
-/

section finite_dimensional

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [finite_dimensional 𝕜 F]
  (f : E → F) (f' : E →L[𝕜] F) {a : E}

/-- Given a map `f : E → F` to a finite dimensional space with a surjective derivative `f'`,
returns a local homeomorphism between `E` and `F × ker f'`. -/
def implicit_to_local_homeomorph (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  local_homeomorph E (F × (ker f')) :=
by haveI := finite_dimensional.complete 𝕜 F; exact
hf.implicit_to_local_homeomorph_of_complemented f f' hf'
  f'.ker_closed_complemented_of_finite_dimensional_range

/-- Implicit function `g` defined by `f (g z y) = z`. -/
def implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  F → (ker f') → E :=
function.curry $ (hf.implicit_to_local_homeomorph f f' hf').symm

variables {f f'}

@[simp] lemma implicit_to_local_homeomorph_fst (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) (x : E) :
  (hf.implicit_to_local_homeomorph f f' hf' x).fst = f x :=
rfl

@[simp] lemma implicit_to_local_homeomorph_apply_ker
  (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) (y : ker f') :
  hf.implicit_to_local_homeomorph f f' hf' (y + a) = (f (y + a), y) :=
by apply implicit_to_local_homeomorph_of_complemented_apply_ker

@[simp] lemma implicit_to_local_homeomorph_self
  (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  hf.implicit_to_local_homeomorph f f' hf' a = (f a, 0) :=
by apply implicit_to_local_homeomorph_of_complemented_self

lemma mem_implicit_to_local_homeomorph_source (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) :
  a ∈ (hf.implicit_to_local_homeomorph f f' hf').source :=
mem_to_local_homeomorph_source _

lemma mem_implicit_to_local_homeomorph_target (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) :
  (f a, (0 : ker f')) ∈ (hf.implicit_to_local_homeomorph f f' hf').target :=
by apply mem_implicit_to_local_homeomorph_of_complemented_target

lemma tendsto_implicit_function (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) {α : Type*} {l : filter α} {g₁ : α → F} {g₂ : α → ker f'}
  (h₁ : tendsto g₁ l (𝓝 $ f a)) (h₂ : tendsto g₂ l (𝓝 0)) :
  tendsto (λ t, hf.implicit_function f f' hf' (g₁ t) (g₂ t)) l (𝓝 a) :=
begin
  refine ((hf.implicit_to_local_homeomorph f f' hf').tendsto_symm
    (hf.mem_implicit_to_local_homeomorph_source hf')).comp _,
  rw [implicit_to_local_homeomorph_self],
  exact h₁.prod_mk_nhds h₂
end

alias tendsto_implicit_function ← _root_.filter.tendsto.implicit_function

/-- `implicit_function` sends `(z, y)` to a point in `f ⁻¹' z`. -/
lemma map_implicit_function_eq (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  ∀ᶠ (p : F × (ker f')) in 𝓝 (f a, 0), f (hf.implicit_function f f' hf' p.1 p.2) = p.1 :=
by apply map_implicit_function_of_complemented_eq

@[simp] lemma implicit_function_apply_image (hf : has_strict_fderiv_at f f' a)
  (hf' : range f' = ⊤) :
  hf.implicit_function f f' hf' (f a) 0 = a :=
by apply implicit_function_of_complemented_apply_image

/-- Any point in some neighborhood of `a` can be represented as `implicit_function`
of some point. -/
lemma eq_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  ∀ᶠ x in 𝓝 a, hf.implicit_function f f' hf' (f x)
    (hf.implicit_to_local_homeomorph f f' hf' x).snd = x :=
by apply eq_implicit_function_of_complemented

lemma to_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) :
  has_strict_fderiv_at (hf.implicit_function f f' hf' (f a))
    (ker f').subtypeL 0 :=
by apply to_implicit_function_of_complemented

end finite_dimensional

end has_strict_fderiv_at


import algebra.group_power.order
import data.nat.prime
import tactic.field_simp
import tactic.linarith
import tactic.ring_exp

import helper

open nat

theorem rootn_not_pn_irr :
  ∀ e n : ℕ,
    ¬ (∃ m : ℕ, m ^ e = n) ↔ ∀ q : ℚ, q ^ e ≠ n :=
begin
  intros e n,
  split,
  {
    intros not_perfect_pow q q_to_e_eq_n,

    by_cases h : q < 0 ∧ odd e,
    {
      have h₁ := neg_odd_pow_lemma h.1 h.2,
      rw q_to_e_eq_n at h₁,
      norm_cast at h₁,
      exact nat.not_lt_zero n h₁,
    },
    {
      have h₁ : q.num.nat_abs ^ e = n * q.denom ^ e :=
        begin
          rw rat.eq_iff_mul_eq_mul at q_to_e_eq_n,
          norm_cast at q_to_e_eq_n,
          rw [mul_one, cast_mul] at q_to_e_eq_n,
          rw ← int.coe_nat_eq_coe_nat_iff,
          field_simp,
          cases ((by tauto!) : ¬(q < 0) ∨ ¬(odd e)) with h' h',
          {
            have q_num_ge_0 : q.num ≥ 0,
            {
              rw [ge_iff_le, rat.num_nonneg_iff_zero_le],
              exact not_lt.1 h',
            },
            norm_cast,
            rw
              [
                (rat_pow_lemma _ _).1,
                (rat_pow_lemma _ _).2,
                ←int.nat_abs_of_nonneg q_num_ge_0
              ] at q_to_e_eq_n,
            norm_cast at q_to_e_eq_n,
            exact q_to_e_eq_n,
          },
          {
            norm_cast,
            rw
              [
                (rat_pow_lemma _ _).1,
                (rat_pow_lemma _ _).2,
                ←abs_pow_eq_pow_of_even_exp (nat.even_iff_not_odd.2 h')
              ] at q_to_e_eq_n,
            norm_cast at q_to_e_eq_n,
            exact q_to_e_eq_n,
          },
        end,

      by_cases q.denom = 1,
      {
        rw [h, one_pow, mul_one] at h₁,
        apply not_perfect_pow,
        exact ⟨q.num.nat_abs, h₁⟩,
      },
      {
        have h₂ : q.denom ∣ q.num.nat_abs :=
          begin
            cases e,
            {
              exfalso,
              apply not_perfect_pow,
              rw pow_zero at q_to_e_eq_n,
              norm_cast at q_to_e_eq_n,
              rw ← q_to_e_eq_n,
              use 0,
              rw pow_zero,
            },
            {
              apply nat.coprime.dvd_of_dvd_mul_left (coprime.pow_right e q.cop.symm),
              use (n * q.denom ^ e),
              conv {
                congr,
                rw [nat.mul_comm, ←pow_succ],
                skip,
                rw [nat.mul_comm, nat.mul_assoc],
                congr,
                skip,
                rw [nat.mul_comm, ←pow_succ],
              },
              exact h₁,
            },
          end,

        have q_cop := q.cop,
        unfold coprime at q_cop,
        rw nat.gcd_eq_right_iff_dvd.1 h₂ at q_cop,
        exact h q_cop,
      },
    },
  },
  {
    rintros h ⟨m, h'⟩,
    have h := h m,
    norm_cast at h,
  },
end

def floor_root' (e n : ℕ) : ℕ → ℕ
| 0 := 0
| k'@(k+1) := if k' ^ e ≤ n then k' else floor_root' k

def floor_root (e n : ℕ) : ℕ := floor_root' e n n

lemma floor_root_lemma (e : ℕ) (h : e ≥ 1): ∀ n : ℕ, (floor_root e n) ^ e ≤ n ∧ n < ((floor_root e n) + 1) ^ e :=
  begin
    intro n,
    unfold floor_root,
    {
      have h₁ : ∀ e n m : ℕ, e ≥ 1 → (m + 1) ^ e > n → floor_root' e n m ^ e ≤ n ∧ n < (floor_root' e n m + 1) ^ e,
      {
        introv,
        revert e_1 n_1,
        induction m,
        {
          introv,
          intros e_ge_1 h₁,
          cases e_1,
          {
            linarith,
          },
          {
            rw [one_pow, gt_iff_lt, lt_one_iff] at h₁,
            unfold floor_root',
            simp only
              [
                h₁, zero_pow', ne.def, succ_ne_zero, not_false_iff,
                le_zero_iff, one_pow, lt_one_iff, and_self
              ],
          },
        },
        {
          introv,
          intros e_ge_1 h₁,
          unfold floor_root',
          split_ifs,
          {
            refine ⟨h_1,h₁⟩,
          },
          {
            exact m_ih _ _ e_ge_1 (by linarith),
          },
        },
      },
      apply h₁ e n n h,
      {
        cases n,
        {
          rw [one_pow, gt_iff_lt, lt_one_iff],
        },
        {
          induction e,
          {
            linarith,
          },
          {
            cases e_n,
            {
              rw [pow_one, gt_iff_lt, lt_add_iff_pos_right, lt_one_iff],
            },
            {
              rw pow_succ,
              conv {
                to_rhs,
                rw ←nat.one_mul n.succ,
              },
              apply sord_mul_lem,
              {
                exact one_lt_succ_succ n,
              },
              {
                apply e_ih,
                apply succ_le_succ,
                exact zero_le e_n,
              },
            },
          },
        },
      },
    },
  end

def is_perfect_pow (n e : ℕ) := ∃ m : ℕ, m ^ e = n

lemma is_pp_equiv_lemma (n e : ℕ) : is_perfect_pow n e ↔ (floor_root e n) ^ e = n :=
  begin
    split,
    {
      intro h,
      by_cases h' : e ≥ 1,
      {
        rcases h with ⟨m, h⟩,
        have h₁ : floor_root e n = m,
        {
          rcases floor_root_lemma e h' n with ⟨h₂, h₃⟩,
          conv at h₂ {
            to_rhs,
            rw ←h,
          },
          conv at h₃ {
            to_lhs,
            rw ←h,
          },
          by_contra,
          cases eq_or_lt_of_le h₂ with h₂ h₂,
          {
            exact h (nat.pow_left_injective h' h₂),
          },
          {
            have h₂ := pow_ord_lemma e h' h₂,
            have h₃ := pow_ord_lemma e h' h₃,
            exact ord_lemma (floor_root e n) ⟨m, h₂, h₃⟩,
          },
        },
        {
          rw h₁,
          exact h,
        },
      },
      {
        have h₁ : e = 0,
        linarith,
        rw h₁ at *,
        rcases h with ⟨m, h⟩,
        exact h,
      },
    },
    {
      intro h,
      use floor_root e n,
      exact h,
    }
  end

instance is_perfect_pow_dec (n e : ℕ) : decidable (is_perfect_pow n e) :=
  decidable_of_iff _ (iff.symm $ is_pp_equiv_lemma n e)

instance has_no_rational_root_dec (n e : ℕ) : decidable (∀ q : ℚ, q ^ e ≠ ↑n) :=
  begin
    haveI inst : decidable (∃ (m : ℕ), m ^ e = n) :=
      eq.rec (is_perfect_pow_dec n e)
      (by refl : is_perfect_pow n e = (∃ (m : ℕ), m ^ e = n)),
    apply decidable_of_iff _ (rootn_not_pn_irr e n),
  end

theorem sqrt_2_irr : ∀ q : ℚ, q ^ 2 ≠ 2 :=
  begin
    have h : (2 : ℚ) = ↑(2 : ℕ) := by norm_cast,
    rw h,
    dec_trivial,
  end

example : ∀ q : ℚ, q ^ 5 ≠ ↑101 := dec_trivial


import MyNat
import MyNat.addition_world
import MyNat.multiplication_world

open MyNat

lemma pow_zero (a : ℕ) : a ^ zero = 1 := rfl
lemma pow_succ (a : ℕ) : a ^ succ b = a * (a ^ b) := rfl

lemma zero_pow_zero : (zero : ℕ) ^ zero = 1 := rfl

lemma zero_pow_succ (m : ℕ) : zero ^ (succ m) = zero :=
  by rewrite [pow_succ, zero_mul] rfl

lemma pow_one (a : ℕ) : a ^ 1 = a :=
  by rewrite [one_eq_succ_zero, pow_succ, pow_zero, mul_one] rfl

lemma pow_add (a m n : ℕ) : a ^ (m + n) = a ^ m * a ^ n :=
  by induction m with
  | zero => rewrite [zero_add, pow_zero, one_mul] rfl
  | succ m' ih => rewrite [pow_succ, succ_add, pow_succ, ih, mul_assoc] rfl

lemma mul_pow (a b n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
  by induction n with
  | zero => rewrite [pow_zero, pow_zero, pow_zero, mul_one] rfl
  | succ n' ih => rewrite [pow_succ, ih, pow_succ, pow_succ, mul_assoc, mul_comm b, mul_assoc, ←mul_assoc, mul_comm _ b] rfl

lemma pow_pow (a m n : ℕ) : (a ^ m) ^ n = a ^ (m * n) :=
 by induction n with
 | zero => rewrite [mul_zero, pow_zero, pow_zero] rfl
 | succ n' ih => rewrite [pow_succ, ih, ←pow_add, ←mul_succ] rfl

lemma add_squared (a b : ℕ) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + (2 * a * b) :=
  by rewrite [two_eq_succ_one, one_eq_succ_zero, pow_succ, pow_succ, pow_succ, pow_succ, pow_succ, pow_succ, pow_zero, mul_one, pow_zero, mul_one, pow_zero, mul_one, add_mul, mul_add, mul_add, mul_comm b a, add_right_comm, add_comm (a * b), add_assoc, add_assoc, add_same, ←add_assoc, ←one_eq_succ_zero, ←two_eq_succ_one, ←mul_assoc] rfl


import data.nat.modeq -- modular arithmetic
import topology.basic

example : 5 ≡ 8 [MOD 3] :=
begin
    apply rfl,
end

#check nat.modeq.modeq_mul

example (a b c d m : ℕ) : a ≡ b [MOD m] → c ≡ d [MOD m] → a * c ≡ b * d [MOD m] :=
begin
    apply nat.modeq.modeq_mul,
end

lemma cong_mul1 (a b c d m : ℕ) : a ≡ b [MOD m] → a * c ≡ b * c [MOD m] :=
begin
    intro h1,
    apply nat.modeq.modeq_mul h1, apply rfl,
end

theorem cong_product (a b c d m : ℕ) (h1: a ≡ b * c [MOD m]) (h2: c ≡ d [MOD m]) : a ≡ b * d [MOD m] :=
begin
    have h3: b * c ≡ b * d [MOD m], from
    begin
        apply nat.modeq.modeq_mul, apply rfl, assumption
    end,
    apply nat.modeq.trans h1 h3,
end

lemma aaa (rr R R_INV a ar aar aaa n : ℕ) :
    R * R_INV ≡ 1 [MOD n] →
    rr ≡ R * R [MOD n] →
    ar ≡ a * R_INV * rr [MOD n] →
    aar ≡ ar * ar * R_INV [MOD n] →
    aaa ≡ aar * a * R_INV [MOD n] →
    aaa ≡ a * a * a [MOD n] :=
begin
    intros h1 h2 h3 h4 h5,
    have h: ar ≡ a * R_INV * R * R [MOD n], from
    begin
        rw [mul_assoc],
        apply cong_product ar (a * R_INV) rr (R * R) n,
        assumption,
        assumption,
    end,

    have h: ar ≡ a * R * 1 [MOD n], from
    begin
        apply cong_product ar (a * R) (R_INV * R) 1 n,
        rw [<- mul_assoc, mul_assoc a R, mul_comm R R_INV, <-mul_assoc],
        assumption,
        rw [mul_comm],
        assumption,
    end,
    sorry
end


import data.real.basic

variables a b : ℝ

-- BEGIN
example (h : a < b) : ¬ b < a :=
begin
  intro h',
  have : a < a,
    from lt_trans h h',
  apply lt_irrefl a this,
end
-- END