open classical

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
⟨λh, ⟨h.right, h.left⟩, λh, ⟨h.right, h.left⟩⟩

example : p ∨ q ↔ q ∨ p :=
⟨λh, h.elim (λh₁, or.inr h₁) (λh₁, or.inl h₁),
λh, h.elim (λh₁, or.inr h₁) (λh₁, or.inl h₁)⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
⟨λh, ⟨h.left.left, ⟨h.left.right, h.right⟩⟩,
λh, ⟨⟨h.left, h.right.left⟩, h.right.right⟩⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
⟨λh, h.elim
    (λh₁, h₁.elim (or.inl) (λh₂, or.inr (or.inl h₂)))
    (λh₁, or.inr (or.inr h₁)),
λh, h.elim
    (λh₁, or.inl (or.inl h₁))
    (λh₁, h₁.elim (λh₂, or.inl (or.inr h₂)) (or.inr))⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
⟨λh, (h.right).elim
    (λh₁, or.inl ⟨h.left, h₁⟩)
    (λh₁, or.inr ⟨h.left, h₁⟩),
λh, h.elim
    (λh₁, ⟨h₁.left, or.inl (h₁.right)⟩)
    (λh₁, ⟨h₁.left, or.inr (h₁.right)⟩)⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
⟨λh, h.elim
    (λh₁, ⟨or.inl h₁, or.inl h₁⟩)
    (λh₁, ⟨or.inr (h₁.left), or.inr (h₁.right)⟩),
λh, (h.left).elim
    (or.inl)
    (λh₁, (h.right.elim (or.inl) (λh₂, or.inr ⟨h₁, h₂⟩)))⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
⟨λh, λh₁, h (h₁.left) (h₁.right),
λh, λh₁, λh₂, h ⟨h₁, h₂⟩⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
⟨λh, ⟨λh₁, h (or.inl h₁), λh₁, h (or.inr h₁)⟩,
λh, λh₁, h₁.elim (h.left) (h.right)⟩

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
⟨λh, ⟨λh₁, h (or.inl h₁), λh₁, h (or.inr h₁)⟩,
λh, λh₁, h₁.elim (h.left) (h.right)⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
λh, λh₁, h.elim (λh₂, h₂ h₁.left) (λh₂, h₂ h₁.right)

example : ¬(p ∧ ¬p) :=
λh, (h.right) (h.left)

example : p ∧ ¬q → ¬(p → q) :=
λh, λh₁, (h.right) (h₁ (h.left))

example : ¬p → (p → q) :=
λh, λh₁, absurd h₁ h

example : (¬p ∨ q) → (p → q) :=
λh, λh₁, h.elim (absurd h₁ h₂=) id

example : p ∨ false ↔ p :=
⟨λh, h.elim id (false.elim), or.inl⟩

example : p ∧ false ↔ false :=
⟨and.right, false.elim⟩

example : ¬(p ↔ ¬p) :=
λh, by_cases (λh₁, (h.mp h₁) h₁) (λh₁, h₁ (h.mpr h₁))

example : (p → q) → (¬q → ¬p) :=
λh, λh₁, λh₂, h₁ (h h₂)

-- these require classical reasoning
open classical
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
λh, by_cases
    (λh₁, (h h₁).elim (λh₂, or.inl (λh₁, h₂)) (λh₂, or.inr (λh₁, h₂)))
    (λh₁, or.inl (λh₂, absurd h₂ h₁))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
λh, by_cases (λh₁, or.inr (λh₂, h ⟨h₁, h₂⟩)) (or.inl)

example : ¬(p → q) → p ∧ ¬q :=
λh, by_cases
    (λh₁, by_cases (λh₂, absurd (λh₁, h₂) h) (and.intro h₁))
    (λh₁, absurd (λh₂, absurd h₂ h₁) h)
/- em q
λh, by_cases
    (λh₁, absurd (λh₂, h₁) h)
    (λh₁, by_cases (λh₂, ⟨h₂, h₁⟩) (λh₂, absurd (λh₃, absurd h₃ h₂) h))
-/

example : (p → q) → (¬p ∨ q) :=
λh, by_cases (λh₁, or.inr (h h₁)) (or.inl)

example : (¬q → ¬p) → (p → q) :=
λh, λh₁, by_contradiction (λh₂, (h h₂) h₁)

example : p ∨ ¬p :=
em p
--by_cases (or.inl) (or.inr)

example : (((p → q) → p) → p) :=
λh, by_contradiction (λh₁, h₁ (h (λh₃, absurd h₃ h₁)))


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

This file is inspired by Johannes Hölzl's implementation of linear algebra in mathlib.

The thing we improved is this file describes finite dimentional vector spaces
-/

import algebra.module -- for definition of vector_space
import linear_algebra.basic -- for definition of is_basis
import data.list.basic
import analysis.real
universes u v

class finite_dimensional_vector_space (k : Type u) (V : Type v) [field k]
  extends vector_space k V :=
(ordered_basis : list V)
(is_ordered_basis : is_basis {v : V | v ∈ ordered_basis})

variables {k : Type u} {V : Type v}
variable [field k]
variable [module k V]
variables {a : k} {b : V}
variable [decidable_eq V]
include k
#check list.has_union
#check finset
definition dimension (fvs : finite_dimensional_vector_space k V) : ℕ :=
fvs.ordered_basis.length
theorem Steinitz_exchange_lemma  (fvs : finite_dimensional_vector_space k V) {S T: list V}
 (SLD: linear_independent {v : V | v ∈ S}) (TSS: span{v : V | v ∈ T} = set.univ) : ∃ T': list V,
 T' ⊆ T ∧  T'.length =T.length ∧
 span {v:V | v ∈ list.diff T  T' ∪ S} = (set.univ : set V) :=
  begin

  end


import Mathlib
/-!
## Linear Diaphontine Equations

We solve linear diaphontine equations of the form `a * x + b * y = c` where `a`, `b`, `c` are integers if they have a solution with proof. Otherwise, we return a proof that there is no solution.
-/

/--
Solution of the linear diaphontine equation `a * x + b * y = c` where `a`, `b`, `c` are integers or a proof that there is no solution.
-/
inductive DiaphontineSolution (a b c : ℤ) where
    | solution : (x y : ℤ) →  a * x + b * y = c → DiaphontineSolution a b c
    | unsolvable : (∀ x y : ℤ, ¬ (a * x + b * y = c)) → DiaphontineSolution a b c

/-!
This has a solution if and only if the gcd of `a` and `b` divides `c`.
* If the gcd of `a` and `b` divides `c`, by Bezout's Lemma there are integers `x` and `y` such that `a * x + b * y = gcd a b`. Further, as `gcd a b` divides `c`, we have an integer `d` such that `(gcd a b) * d = c`. Then `x * d` and `y * d` are integers such that `a * (x * d) + b * (y * d) = c`.
* The converse follows as `gcd a b` divides `a` and `b`, hence `c = a * x + b * y`.

The main results we need are in the library. Here are most of them:

```lean
#check Int.gcd_dvd_left -- ∀ (i j : ℤ), ↑(Int.gcd i j) ∣ i
#check Int.emod_add_ediv -- ∀ (a b : ℤ), a % b + b * (a / b) = a
#check Int.emod_eq_zero_of_dvd -- ∀ {a b : ℤ}, a ∣ b → b % a = 0
#check Int.dvd_mul_right -- ∀ (a b : ℤ), a ∣ a * b
#check Int.gcd_eq_gcd_ab -- ∀ (x y : ℤ), ↑(Int.gcd x y) = x * Int.gcdA x y + y * Int.gcdB x y
#check dvd_add /-∀ {α : Type u_1} [inst : Add α] [inst_1 : Semigroup α] [inst_2 : LeftDistribClass α] {a b c : α},
  a ∣ b → a ∣ c → a ∣ b + c-/
```
-/

#check Int.gcd_dvd_left -- ∀ (i j : ℤ), ↑(Int.gcd i j) ∣ i
#check Int.emod_add_ediv -- ∀ (a b : ℤ), a % b + b * (a / b) = a
#check Int.emod_eq_zero_of_dvd -- ∀ {a b : ℤ}, a ∣ b → b % a = 0
#check Int.dvd_mul_right -- ∀ (a b : ℤ), a ∣ a * b
#check Int.gcd_eq_gcd_ab -- ∀ (x y : ℤ), ↑(Int.gcd x y) = x * Int.gcdA x y + y * Int.gcdB x y
#check dvd_add /-∀ {α : Type u_1} [inst : Add α] [inst_1 : Semigroup α] [inst_2 : LeftDistribClass α] {a b c : α},
  a ∣ b → a ∣ c → a ∣ b + c-/

/--
Given `a b : ℤ` such that `b ∣ a`, we return an integer `q` such that `a = b * q`.
-/
def dvdQuotient (a b: Int)(h : b ∣ a) : {q : Int // a = b * q} :=
    let q := a / b
    ⟨q, by
        rw [← Int.emod_add_ediv a b, Int.emod_eq_zero_of_dvd h, zero_add]
        ⟩

/-- If `a * x + b * y = c` has a solution, then `gcd a b` divides `c`.
-/
lemma eqn_solvable_divides (a b c : ℤ) :
    (∃ x : ℤ, ∃ y : ℤ,  a * x + b * y = c) →  ↑(Int.gcd a b) ∣ c := by
    intro ⟨x, y, h⟩
    rw [← h]
    apply dvd_add
    · trans a
      · apply Int.gcd_dvd_left
      · apply Int.dvd_mul_right
    · trans b
      · apply Int.gcd_dvd_right
      · apply Int.dvd_mul_right

/-- Solution or proof there is no solution for `a * x + b * y = c`  -/
def DiaphontineSolution.solve (a b c : ℤ) : DiaphontineSolution a b c :=
    if h : ↑(Int.gcd a b) ∣ c
    then
    by
        let ⟨d, h'⟩ := dvdQuotient (c: Int) (Int.gcd a b)  h
        rw [Int.gcd_eq_gcd_ab a b] at h'
        rw [add_mul, mul_assoc, mul_assoc] at h'
        let x := (Int.gcdA a b * d)
        let y := (Int.gcdB a b * d)
        exact DiaphontineSolution.solution x y h'.symm
    else
        by
        apply DiaphontineSolution.unsolvable
        intro x y contra
        apply h
        apply eqn_solvable_divides a b c
        use x, y
        assumption


/-
Copyright (c) 2022 Pim Otte. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller, Pim Otte

! This file was ported from Lean 3 source module data.nat.factorial.big_operators
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Factorial.Basic
import Mathbin.Algebra.BigOperators.Order

/-!
# Factorial with big operators

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

This file contains some lemmas on factorials in combination with big operators.

While in terms of semantics they could be in the `basic.lean` file, importing
`algebra.big_operators.basic` leads to a cyclic import.

-/

open Nat BigOperators

namespace Nat

variable {α : Type _} (s : Finset α) (f : α → ℕ)

#print Nat.prod_factorial_pos /-
theorem prod_factorial_pos : 0 < ∏ i in s, (f i)! :=
  Finset.prod_pos fun i _ => factorial_pos (f i)
#align nat.prod_factorial_pos Nat.prod_factorial_pos
-/

#print Nat.prod_factorial_dvd_factorial_sum /-
theorem prod_factorial_dvd_factorial_sum : (∏ i in s, (f i)!) ∣ (∑ i in s, f i)! := by
  classical
    induction' s using Finset.induction with a' s' has ih
    · simp only [Finset.sum_empty, Finset.prod_empty, factorial]
    · simp only [Finset.prod_insert has, Finset.sum_insert has]
      refine' dvd_trans (mul_dvd_mul_left (f a')! ih) _
      apply Nat.factorial_mul_factorial_dvd_factorial_add
#align nat.prod_factorial_dvd_factorial_sum Nat.prod_factorial_dvd_factorial_sum
-/

end Nat


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.pgame
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Basic definitions about who has a winning stratergy

We define `G.first_loses`, `G.first_wins`, `G.left_wins` and `G.right_wins` for a pgame `G`, which
means the second, first, left and right players have a winning strategy respectively.
These are defined by inequalities which can be unfolded with `pgame.lt_def` and `pgame.le_def`.
-/

namespace pgame

/-- The player who goes first loses -/
def first_loses (G : pgame) := G ≤ 0 ∧ 0 ≤ G

/-- The player who goes first wins -/
def first_wins (G : pgame) := 0 < G ∧ G < 0

/-- The left player can always win -/
def left_wins (G : pgame) := 0 < G ∧ 0 ≤ G

/-- The right player can always win -/
def right_wins (G : pgame) := G ≤ 0 ∧ G < 0

theorem zero_first_loses : first_loses 0 := { left := le_refl 0, right := le_refl 0 }

theorem one_left_wins : left_wins 1 := sorry

theorem star_first_wins : first_wins star := { left := zero_lt_star, right := star_lt_zero }

theorem omega_left_wins : left_wins omega := sorry

theorem winner_cases (G : pgame) : left_wins G ∨ right_wins G ∨ first_loses G ∨ first_wins G :=
  sorry

theorem first_loses_is_zero {G : pgame} : first_loses G ↔ equiv G 0 := iff.refl (first_loses G)

theorem first_loses_of_equiv {G : pgame} {H : pgame} (h : equiv G H) :
    first_loses G → first_loses H :=
  fun (hGp : first_loses G) =>
    { left := le_of_equiv_of_le (and.symm h) (and.left hGp),
      right := le_of_le_of_equiv (and.right hGp) h }

theorem first_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : first_wins G → first_wins H :=
  fun (hGn : first_wins G) =>
    { left := lt_of_lt_of_equiv (and.left hGn) h,
      right := lt_of_equiv_of_lt (and.symm h) (and.right hGn) }

theorem left_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : left_wins G → left_wins H :=
  fun (hGl : left_wins G) =>
    { left := lt_of_lt_of_equiv (and.left hGl) h, right := le_of_le_of_equiv (and.right hGl) h }

theorem right_wins_of_equiv {G : pgame} {H : pgame} (h : equiv G H) : right_wins G → right_wins H :=
  fun (hGr : right_wins G) =>
    { left := le_of_equiv_of_le (and.symm h) (and.left hGr),
      right := lt_of_equiv_of_lt (and.symm h) (and.right hGr) }

theorem first_loses_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) :
    first_loses G ↔ first_loses H :=
  { mp := first_loses_of_equiv h, mpr := first_loses_of_equiv (and.symm h) }

theorem first_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) :
    first_wins G ↔ first_wins H :=
  { mp := first_wins_of_equiv h, mpr := first_wins_of_equiv (and.symm h) }

theorem left_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) :
    left_wins G ↔ left_wins H :=
  { mp := left_wins_of_equiv h, mpr := left_wins_of_equiv (and.symm h) }

theorem right_wins_of_equiv_iff {G : pgame} {H : pgame} (h : equiv G H) :
    right_wins G ↔ right_wins H :=
  { mp := right_wins_of_equiv h, mpr := right_wins_of_equiv (and.symm h) }

theorem not_first_wins_of_first_loses {G : pgame} : first_loses G → ¬first_wins G := sorry

theorem not_first_loses_of_first_wins {G : pgame} : first_wins G → ¬first_loses G :=
  iff.mp imp_not_comm not_first_wins_of_first_loses

end Mathlib


-- 1
section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable  h : ∀x, P x → P (f x)

  example : ∀y, P y → P (f (f y)) :=
  assume y,
    assume Py, have Pfy : P (f y), from h y Py,
    show P (f (f y)), from h (f y) Pfy
end

-- 2
section
  variable U : Type
  variables A B : U → Prop

  example : (∀x, A x ∧ B x) → ∀x, A x :=
      assume allXwAandB : (∀ x, A x ∧ B x), assume x,
    have AAndB : A x ∧ B x, from allXwAandB x, show A x, from and.elim_left AAndB
end

-- 3
section
  variable U : Type
  variables A B C : U → Prop

  variable h1 : ∀x, A x ∨ B x
  variable h2 : ∀x, A x → C x
  variable h3 : ∀x, B x → C x

  example : ∀x, C x :=
  assume x,
  or.elim (h1 x) (assume Ax, h2 x Ax) (assume Bx, h3 x Bx)
end

-- 4
open classical

axiom not_iff_not_self (P : Prop) : ¬(P ↔ ¬P)

example (Q : Prop) : ¬(Q ↔ ¬Q) :=
not_iff_not_self Q

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀x, shaves barber x ↔ ¬shaves x x

  example : false :=
  (not_iff_not_self (shaves barber barber)) (h barber)
end

-- 5
section
  variable U : Type
  variables A B : U → Prop

  example : (∃x, A x) → ∃x, A x ∨ B x :=
  assume existentialAx, exists.elim existentialAx $
  assume x Ax, have A x ∨ B x, from or.inl Ax, exists.intro x ‹A x ∨ B x›
end

-- 6
section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀x, A x → B x
  variable h2 : ∃x, A x

  example : ∃x, B x :=
   exists.elim h2 $
  assume x Ax, exists.intro x (h1 x Ax)
end

-- 7
section
  variable  U : Type
  variables A B C : U → Prop

  example (h1 : ∃x, A x ∧ B x) (h2 : ∀x, B x → C x) :
    ∃x, A x ∧ C x :=
    exists.elim h1 $
    assume x AxBx, have A x, from and.elim_left AxBx, have B x, from and.elim_right AxBx, have C x, from h2 x ‹B x›,
    exists.intro x ⟨‹A x›, ‹C x›⟩
end

-- 8
section
  variable  U : Type
  variables A B C : U → Prop

  example : (¬∃x, A x) → ∀x, ¬A x :=
  assume notexAx : ¬ ∃ x, A x,
    assume x, assume : A x,
    have exAx : ∃ x, A x, from exists.intro x ‹A x›,
    show false, from notexAx exAx

end

-- 9
section
  variable  U : Type
  variables A B C : U → Prop

  example : (∀x, ¬A x) → ¬∃x, A x :=
  assume axnotAx : ∀ x, ¬ A x,
  assume exAx : ∃ x, A x, exists.elim exAx $
  assume x (_ : A x), have ¬ A x, from axnotAx x, show false, from ‹¬ A x› ‹A x›
end

-- 10
section
  variable  U : Type
  variables R : U → U → Prop

  example : (∃x, ∀y, R x y) → ∀y, ∃x, R x y :=
  assume exAyRxy : ∃ x, ∀ y, R x y, exists.elim exAyRxy $
  assume x (h2 : ∀ y, R x y), assume y, have R x y, from h2 y,exists.intro x ‹R x y›
end


-- a^7 = b^7 syss a = b
-- ====================

import tactic
import algebra.order.ring

theorem ex_1_3_5
  {α}
  [linear_ordered_ring α]
  (a b : α)
  (h : a^7 = b^7)
  : a = b :=
(@strict_mono_pow_bit1 α _ 3).injective h

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

-- Mario Carneiro "if a^7=b^7 then a=b" https://bit.ly/3oyBS6M


import Aesop
import Duck.Math.CategoryTheory
open Math.CategoryTheory

namespace Math.GroupTheory

universe u v

class Group (G : Type u) where
  mul : G → G → G
  unit : G
  mul_assoc : ∀ (x y z : G), mul x (mul y z) = mul (mul x y) z
  mul_unit : ∀ (x : G), mul x unit = x
  unit_mul : ∀ (x : G), mul unit x = x
  inv : G → G
  mul_inv : ∀ (x : G), mul x (inv x) = unit
  inv_mul : ∀ (x : G), mul (inv x) x = unit

infixr:80 " ⬝ " => Group.mul

structure GroupHom (G H : Type u) (cG : Group G) (cH : Group H) where
  f : G → H
  hf : ∀ (x y : G), f (x ⬝ y) = (f x) ⬝ (f y)

instance : Category (Bundle Group) where
  Hom B₁ B₂ := GroupHom B₁.α B₂.α B₁.str B₂.str;
  id B := { f := id, hf := by intros; unfold id; rfl; }
  comp f g := { f := f.f ∘ g.f, hf := by intros; unfold Function.comp; rw [g.hf, f.hf]; }
  comp_assoc f g h := by rfl;
  comp_id f := by rfl;
  id_comp f := by rfl;

namespace Group
-- A group is trivial if it has one element.
def trivial (G : Type u) [Group G] := ∀ (x : G), x = unit
-- A group is abelian if $xy = yx$ for all $x, y \in G$.
def abelian (G : Type u) [Group G] := ∀ (x y : G), x ⬝ y = y ⬝ x
axiom solvable (G : Type u) [Group G] : Prop
axiom finitely_generated (G : Type u) [Group G] : Prop
-- A group is a torsion group if every element has finite order.
axiom torsion (G : Type u) [Group G] : Prop
-- A group $G$ is simple if its only normal subgroups are $\{ 1 \}$ and $G$ itself.
axiom simple (G : Type u) [Group G] : Prop
-- A subgroup $H \subset G$ is normal if $g H g^{-1} = H$ for all $g \in G$.
-- axiom normal {G H : Type u} [Group G] [Group H] (i : H ⟶ G) : Prop
-- A subgroup $H \subset G$ is central if it lies in the center of $G$.
-- axiom central {G H : Group} (i : H ⟶ G) : Prop
-- Whenever $N \subset G$ is a normal subgroup, one can form the quotient group $G/N$.
-- axiom quotient {G N : Group} {i : N ⟶ G} (h : normal i) : Group
end Group

variable {G : Type u} [Group G]

theorem mul_right {x y : G} (z : G) (h : x = y) : x ⬝ z = y ⬝ z := by rw [h];
theorem mul_left {x y : G} (z : G) (h : x = y) : z ⬝ x = z ⬝ y := by rw [h];

theorem inv_inv (x : G) : Group.inv (Group.inv x) = x := by {
  have q := mul_right x $ Group.inv_mul (Group.inv x);
  rw [← Group.mul_assoc, Group.inv_mul, Group.mul_unit, Group.unit_mul] at q;
  exact q;
}

end Math.GroupTheory


variable f : ℕ → ℕ
variable h : ∀ x : ℕ, f x ≤ f (x + 1)

example : f 0 ≤ f 3 :=
  have f 0 ≤ f 1, from h 0,
  have f 1 ≤ f 2, from h 1,
  have f 2 ≤ f 3, from h 2,
  show f 0 ≤ f 3, from
    le_trans ‹f 0 ≤ f 1›
      (le_trans ‹f 1 ≤ f 2› ‹f 2 ≤ f 3›)


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

! This file was ported from Lean 3 source module set_theory.ordinal.principal
! leanprover-community/mathlib commit 9b2660e1b25419042c8da10bf411aa3c67f14383
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.SetTheory.Ordinal.FixedPoint

/-!
### Principal ordinals

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

### Main definitions and results
* `Principal`: A principal or indecomposable ordinal under some binary operation. We include 0 and
  any other typically excluded edge cases for simplicity.
* `unbounded_principal`: Principal ordinals are unbounded.
* `principal_add_iff_zero_or_omega_opow`: The main characterization theorem for additive principal
  ordinals.
* `principal_mul_iff_le_two_or_omega_opow_opow`: The main characterization theorem for
  multiplicative principal ordinals.

### Todo
* Prove that exponential principal ordinals are 0, 1, 2, ω, or epsilon numbers, i.e. fixed points
  of `λ x, ω ^ x`.
-/

universe u v w

noncomputable section

open Order

namespace Ordinal

-- Porting note: commented out, doesn't seem necessary
--local infixr:0 "^" => @pow Ordinal Ordinal Ordinal.hasPow

/-! ### 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
#align ordinal.principal Ordinal.Principal

theorem principal_iff_principal_swap {op : Ordinal → Ordinal → Ordinal} {o : Ordinal} :
    Principal op o ↔ Principal (Function.swap op) o := by
  constructor <;> exact fun h a b ha hb => h hb ha
#align ordinal.principal_iff_principal_swap Ordinal.principal_iff_principal_swap

theorem principal_zero {op : Ordinal → Ordinal → Ordinal} : Principal op 0 := fun a _ h =>
  (Ordinal.not_lt_zero a h).elim
#align ordinal.principal_zero Ordinal.principal_zero

@[simp]
theorem principal_one_iff {op : Ordinal → Ordinal → Ordinal} : Principal op 1 ↔ op 0 0 = 0 := by
  refine' ⟨fun h => _, fun h a b ha hb => _⟩
  · rw [← lt_one_iff_zero]
    exact h zero_lt_one zero_lt_one
  · rwa [lt_one_iff_zero, ha, hb] at *
#align ordinal.principal_one_iff Ordinal.principal_one_iff

theorem Principal.iterate_lt {op : Ordinal → Ordinal → Ordinal} {a o : Ordinal} (hao : a < o)
    (ho : Principal op o) (n : ℕ) : (op a^[n]) a < o := by
  induction' n with n hn
  · rwa [Function.iterate_zero]
  · rw [Function.iterate_succ']
    exact ho hao hn
#align ordinal.principal.iterate_lt Ordinal.Principal.iterate_lt

theorem op_eq_self_of_principal {op : Ordinal → Ordinal → Ordinal} {a o : Ordinal.{u}} (hao : a < o)
    (H : IsNormal (op a)) (ho : Principal op o) (ho' : IsLimit o) : op a o = o := by
  refine' le_antisymm _ (H.self_le _)
  rw [← IsNormal.bsup_eq.{u, u} H ho', bsup_le_iff]
  exact fun b hbo => (ho hao hbo).le
#align ordinal.op_eq_self_of_principal Ordinal.op_eq_self_of_principal

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 fun n => (ho.iterate_lt hao n).le
#align ordinal.nfp_le_of_principal Ordinal.nfp_le_of_principal

/-! ### 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 fun x : o.out.α × o.out.α => op (typein LT.lt x.1) (typein LT.lt x.2)
#align ordinal.blsub₂ Ordinal.blsub₂

theorem lt_blsub₂ (op : Ordinal.{u} → Ordinal.{u} → Ordinal.{max u v})
  {o a b : Ordinal.{u}} (ha : a < o)
    (hb : b < o) : op a b < blsub₂.{u, v} op o := by
  convert lt_lsub.{v, u}
      (fun x : (Quotient.out.{u+2} o).α × (Quotient.out.{u+2} o).α =>
        op (typein.{u} LT.lt x.fst) (typein.{u} LT.lt x.snd))
      (Prod.mk.{u, u} (enum.{u} LT.lt a (by rwa [type_lt])) (enum.{u} LT.lt b (by rwa [type_lt])))
  <;> simp only [typein_enum]
#align ordinal.lt_blsub₂ Ordinal.lt_blsub₂

theorem principal_nfp_blsub₂ (op : Ordinal → Ordinal → Ordinal) (o : Ordinal) :
    Principal op (nfp (blsub₂.{u, u} op) o) := fun a b ha hb => by
  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)
#align ordinal.principal_nfp_blsub₂ Ordinal.principal_nfp_blsub₂

theorem unbounded_principal (op : Ordinal → Ordinal → Ordinal) :
    Set.Unbounded (· < ·) { o | Principal op o } := fun o =>
  ⟨_, principal_nfp_blsub₂ op o, (le_nfp _ o).not_lt⟩
#align ordinal.unbounded_principal Ordinal.unbounded_principal

/-! #### Additive principal ordinals -/

theorem principal_add_one : Principal (· + ·) 1 :=
  principal_one_iff.2 <| zero_add 0
#align ordinal.principal_add_one Ordinal.principal_add_one

theorem principal_add_of_le_one {o : Ordinal} (ho : o ≤ 1) : Principal (· + ·) o := by
  rcases le_one_iff.1 ho with (rfl | rfl)
  · exact principal_zero
  · exact principal_add_one
#align ordinal.principal_add_of_le_one Ordinal.principal_add_of_le_one

theorem principal_add_isLimit {o : Ordinal} (ho₁ : 1 < o) (ho : Principal (· + ·) o) : o.IsLimit :=
  by
  refine' ⟨fun ho₀ => _, fun a hao => _⟩
  · rw [ho₀] at ho₁
    exact not_lt_of_gt zero_lt_one ho₁
  · cases' eq_or_ne a 0 with ha ha
    · rw [ha, succ_zero]
      exact ho₁
    · refine' lt_of_le_of_lt _ (ho hao hao)
      rwa [← add_one_eq_succ, add_le_add_iff_left, one_le_iff_ne_zero]
#align ordinal.principal_add_is_limit Ordinal.principal_add_isLimit

theorem principal_add_iff_add_left_eq_self {o : Ordinal} :
    Principal (· + ·) o ↔ ∀ a < o, a + o = o := by
  refine' ⟨fun ho a hao => _, fun h a b hao hbo => _⟩
  · cases' lt_or_le 1 o with ho₁ ho₁
    · exact op_eq_self_of_principal hao (add_isNormal a) ho (principal_add_isLimit ho₁ ho)
    · rcases le_one_iff.1 ho₁ with (rfl | rfl)
      · exact (Ordinal.not_lt_zero a hao).elim
      · rw [lt_one_iff_zero] at hao
        rw [hao, zero_add]
  · rw [← h a hao]
    exact (add_isNormal a).strictMono hbo
#align ordinal.principal_add_iff_add_left_eq_self Ordinal.principal_add_iff_add_left_eq_self

theorem exists_lt_add_of_not_principal_add {a} (ha : ¬Principal (· + ·) a) :
    ∃ (b c : _) (_ : b < a)(_ : c < a), b + c = a := by
  unfold Principal at ha
  push_neg  at ha
  rcases ha with ⟨b, c, hb, hc, H⟩
  refine'
    ⟨b, _, hb, lt_of_le_of_ne (sub_le_self a b) fun hab => _, Ordinal.add_sub_cancel_of_le hb.le⟩
  rw [← sub_le, hab] at H
  exact H.not_lt hc
#align ordinal.exists_lt_add_of_not_principal_add Ordinal.exists_lt_add_of_not_principal_add

theorem principal_add_iff_add_lt_ne_self {a} :
    Principal (· + ·) a ↔ ∀ ⦃b c⦄, b < a → c < a → b + c ≠ a :=
  ⟨fun ha b c hb hc => (ha hb hc).ne, fun H =>
    by
    by_contra' ha
    rcases exists_lt_add_of_not_principal_add ha with ⟨b, c, hb, hc, rfl⟩
    exact (H hb hc).irrefl⟩
#align ordinal.principal_add_iff_add_lt_ne_self Ordinal.principal_add_iff_add_lt_ne_self

theorem add_omega {a : Ordinal} (h : a < omega) : a + omega = omega := by
  rcases lt_omega.1 h with ⟨n, rfl⟩
  clear h; induction' n with n IH
  · rw [Nat.cast_zero, zero_add]
  · rwa [Nat.cast_succ, add_assoc, one_add_of_omega_le (le_refl _)]
#align ordinal.add_omega Ordinal.add_omega

theorem principal_add_omega : Principal (· + ·) omega :=
  principal_add_iff_add_left_eq_self.2 fun _ => add_omega
#align ordinal.principal_add_omega Ordinal.principal_add_omega

theorem add_omega_opow {a b : Ordinal} (h : a < (omega^b)) : a + (omega^b) = (omega^b) := by
  refine' le_antisymm _ (le_add_left _ _)
  induction' b using limitRecOn with b _ b l IH
  · rw [opow_zero, ← succ_zero, lt_succ_iff, Ordinal.le_zero] at h
    rw [h, zero_add]
  · rw [opow_succ] at h
    rcases(lt_mul_of_limit omega_isLimit).1 h with ⟨x, xo, ax⟩
    refine' le_trans (add_le_add_right (le_of_lt ax) _) _
    rw [opow_succ, ← mul_add, add_omega xo]
  · rcases(lt_opow_of_limit omega_ne_zero l).1 h with ⟨x, xb, ax⟩
    exact
      (((add_isNormal a).trans (opow_isNormal one_lt_omega)).limit_le l).2 fun y yb =>
        (add_le_add_left (opow_le_opow_right omega_pos (le_max_right _ _)) _).trans
          (le_trans
            (IH _ (max_lt xb yb) (ax.trans_le <| opow_le_opow_right omega_pos (le_max_left _ _)))
            (opow_le_opow_right omega_pos <| le_of_lt <| max_lt xb yb))
#align ordinal.add_omega_opow Ordinal.add_omega_opow

theorem principal_add_omega_opow (o : Ordinal) : Principal (· + ·) (omega^o) :=
  principal_add_iff_add_left_eq_self.2 fun _ => add_omega_opow
#align ordinal.principal_add_omega_opow Ordinal.principal_add_omega_opow

/-- The main characterization theorem for additive principal ordinals. -/
theorem principal_add_iff_zero_or_omega_opow {o : Ordinal} :
    Principal (· + ·) o ↔ o = 0 ∨ ∃ a, o = (omega^a) := by
  rcases eq_or_ne o 0 with (rfl | ho)
  · simp only [principal_zero, Or.inl]
  · rw [principal_add_iff_add_left_eq_self]
    simp only [ho, false_or_iff]
    refine'
      ⟨fun H => ⟨_, ((lt_or_eq_of_le (opow_log_le_self _ ho)).resolve_left fun h => _).symm⟩,
        fun ⟨b, e⟩ => e.symm ▸ fun a => add_omega_opow⟩
    have := H _ h
    have := lt_opow_succ_log_self one_lt_omega o
    rw [opow_succ, lt_mul_of_limit omega_isLimit] at this
    rcases this with ⟨a, ao, h'⟩
    rcases lt_omega.1 ao with ⟨n, rfl⟩
    clear ao
    revert h'
    apply not_lt_of_le
    suffices e : (omega^log omega o) * ↑n + o = o
    · simpa only [e] using le_add_right ((omega^log omega o) * ↑n) o
    induction' n with n IH
    · simp [Nat.cast_zero, mul_zero, zero_add]
    simp only [Nat.cast_succ, mul_add_one, add_assoc, this, IH]
#align ordinal.principal_add_iff_zero_or_omega_opow Ordinal.principal_add_iff_zero_or_omega_opow

theorem opow_principal_add_of_principal_add {a} (ha : Principal (· + ·) a) (b : Ordinal) :
    Principal (· + ·) (a^b) := by
  rcases principal_add_iff_zero_or_omega_opow.1 ha with (rfl | ⟨c, rfl⟩)
  · rcases eq_or_ne b 0 with (rfl | hb)
    · rw [opow_zero]
      exact principal_add_one
    · rwa [zero_opow hb]
  · rw [← opow_mul]
    exact principal_add_omega_opow _
#align ordinal.opow_principal_add_of_principal_add Ordinal.opow_principal_add_of_principal_add

theorem add_absorp {a b c : Ordinal} (h₁ : a < (omega^b)) (h₂ : (omega^b) ≤ c) : a + c = c := by
  rw [← Ordinal.add_sub_cancel_of_le h₂, ← add_assoc, add_omega_opow h₁]
#align ordinal.add_absorp Ordinal.add_absorp

theorem mul_principal_add_is_principal_add (a : Ordinal.{u}) {b : Ordinal.{u}} (hb₁ : b ≠ 1)
    (hb : Principal (· + ·) b) : Principal (· + ·) (a * b) := by
  rcases eq_zero_or_pos a with (rfl | _)
  · rw [zero_mul]
    exact principal_zero
  · rcases eq_zero_or_pos b with (rfl | hb₁')
    · rw [mul_zero]
      exact principal_zero
    · rw [← succ_le_iff, succ_zero] at hb₁'
      intro c d hc hd
      rw [lt_mul_of_limit (principal_add_isLimit (lt_of_le_of_ne hb₁' hb₁.symm) hb)] at *
      · rcases hc with ⟨x, hx, hx'⟩
        rcases hd with ⟨y, hy, hy'⟩
        use x + y, hb hx hy
        rw [mul_add]
        exact Left.add_lt_add hx' hy'
#align ordinal.mul_principal_add_is_principal_add Ordinal.mul_principal_add_is_principal_add

/-! #### Multiplicative principal ordinals -/

theorem principal_mul_one : Principal (· * ·) 1 := by
  rw [principal_one_iff]
  exact zero_mul _
#align ordinal.principal_mul_one Ordinal.principal_mul_one

theorem principal_mul_two : Principal (· * ·) 2 := fun a b ha hb => by
  have h₂ : succ (1 : Ordinal) = 2 := by simp
  dsimp only
  rw [← h₂, lt_succ_iff] at ha hb ⊢
  convert mul_le_mul' ha hb
  exact (mul_one 1).symm
#align ordinal.principal_mul_two Ordinal.principal_mul_two

theorem principal_mul_of_le_two {o : Ordinal} (ho : o ≤ 2) : Principal (· * ·) o := by
  rcases lt_or_eq_of_le ho with (ho | rfl)
  · have h₂ : succ (1 : Ordinal) = 2 := by simp
    rw [← h₂, lt_succ_iff] at ho
    rcases lt_or_eq_of_le ho with (ho | rfl)
    · rw [lt_one_iff_zero.1 ho]
      exact principal_zero
    · exact principal_mul_one
  · exact principal_mul_two
#align ordinal.principal_mul_of_le_two Ordinal.principal_mul_of_le_two

theorem principal_add_of_principal_mul {o : Ordinal} (ho : Principal (· * ·) o) (ho₂ : o ≠ 2) :
    Principal (· + ·) o := by
  cases' lt_or_gt_of_ne ho₂ with ho₁ ho₂
  · replace ho₁ : o < succ 1 := by simpa using ho₁
    rw [lt_succ_iff] at ho₁
    exact principal_add_of_le_one ho₁
  · refine' fun a b hao hbo => lt_of_le_of_lt _ (ho (max_lt hao hbo) ho₂)
    dsimp only
    rw [← one_add_one_eq_two, mul_add, mul_one]
    exact add_le_add (le_max_left a b) (le_max_right a b)
#align ordinal.principal_add_of_principal_mul Ordinal.principal_add_of_principal_mul

theorem principal_mul_isLimit {o : Ordinal.{u}} (ho₂ : 2 < o) (ho : Principal (· * ·) o) :
    o.IsLimit :=
  principal_add_isLimit ((lt_succ 1).trans (by simpa using ho₂))
    (principal_add_of_principal_mul ho (ne_of_gt ho₂))
#align ordinal.principal_mul_is_limit Ordinal.principal_mul_isLimit

theorem principal_mul_iff_mul_left_eq {o : Ordinal} :
    Principal (· * ·) o ↔ ∀ a, 0 < a → a < o → a * o = o := by
  refine' ⟨fun h a ha₀ hao => _, fun h a b hao hbo => _⟩
  · cases' le_or_gt o 2 with ho ho
    · convert one_mul o
      apply le_antisymm
      · have : a < succ 1 := hao.trans_le (by simpa using ho)
        rwa [lt_succ_iff] at this
      · rwa [← succ_le_iff, succ_zero] at ha₀
    · exact op_eq_self_of_principal hao (mul_isNormal ha₀) h (principal_mul_isLimit ho h)
  · rcases eq_or_ne a 0 with (rfl | ha)
    · dsimp only; rwa [zero_mul]
    rw [← Ordinal.pos_iff_ne_zero] at ha
    rw [← h a ha hao]
    exact (mul_isNormal ha).strictMono hbo
#align ordinal.principal_mul_iff_mul_left_eq Ordinal.principal_mul_iff_mul_left_eq

theorem principal_mul_omega : Principal (· * ·) omega := fun a b ha hb =>
  match a, b, lt_omega.1 ha, lt_omega.1 hb with
  | _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ => by
    dsimp only; rw [← nat_cast_mul]
    apply nat_lt_omega
#align ordinal.principal_mul_omega Ordinal.principal_mul_omega

theorem mul_omega {a : Ordinal} (a0 : 0 < a) (ha : a < omega) : a * omega = omega :=
  principal_mul_iff_mul_left_eq.1 principal_mul_omega a a0 ha
#align ordinal.mul_omega Ordinal.mul_omega

theorem mul_lt_omega_opow {a b c : Ordinal} (c0 : 0 < c) (ha : a < (omega^c)) (hb : b < omega) :
    a * b < (omega^c) := by
  rcases zero_or_succ_or_limit c with (rfl | ⟨c, rfl⟩ | l)
  · exact (lt_irrefl _).elim c0
  · rw [opow_succ] at ha
    rcases((mul_isNormal <| opow_pos _ omega_pos).limit_lt omega_isLimit).1 ha with ⟨n, hn, an⟩
    apply (mul_le_mul_right' (le_of_lt an) _).trans_lt
    rw [opow_succ, mul_assoc, mul_lt_mul_iff_left (opow_pos _ omega_pos)]
    exact principal_mul_omega hn hb
  · rcases((opow_isNormal one_lt_omega).limit_lt l).1 ha with ⟨x, hx, ax⟩
    refine' (mul_le_mul' (le_of_lt ax) (le_of_lt hb)).trans_lt _
    rw [← opow_succ, opow_lt_opow_iff_right one_lt_omega]
    exact l.2 _ hx
#align ordinal.mul_lt_omega_opow Ordinal.mul_lt_omega_opow

theorem mul_omega_opow_opow {a b : Ordinal} (a0 : 0 < a) (h : a < (omega^omega^b)) :
    a * (omega^omega^b) = (omega^omega^b) := by
  by_cases b0 : b = 0;
  · rw [b0, opow_zero, opow_one] at h⊢
    exact mul_omega a0 h
  refine'
    le_antisymm _
      (by simpa only [one_mul] using mul_le_mul_right' (one_le_iff_pos.2 a0) (omega^omega^b))
  rcases(lt_opow_of_limit omega_ne_zero (opow_isLimit_left omega_isLimit b0)).1 h with ⟨x, xb, ax⟩
  apply (mul_le_mul_right' (le_of_lt ax) _).trans
  rw [← opow_add, add_omega_opow xb]
#align ordinal.mul_omega_opow_opow Ordinal.mul_omega_opow_opow

theorem principal_mul_omega_opow_opow (o : Ordinal) : Principal (· * ·) (omega^omega^o) :=
  principal_mul_iff_mul_left_eq.2 fun _ => mul_omega_opow_opow
#align ordinal.principal_mul_omega_opow_opow Ordinal.principal_mul_omega_opow_opow

/-- The main characterization theorem for multiplicative principal ordinals. -/
theorem principal_mul_iff_le_two_or_omega_opow_opow {o : Ordinal} :
    Principal (· * ·) o ↔ o ≤ 2 ∨ ∃ a, o = (omega^omega^a) := by
  refine' ⟨fun ho => _, _⟩
  · cases' le_or_lt o 2 with ho₂ ho₂
    · exact Or.inl ho₂
    rcases principal_add_iff_zero_or_omega_opow.1 (principal_add_of_principal_mul ho ho₂.ne') with
      (rfl | ⟨a, rfl⟩)
    · exact (Ordinal.not_lt_zero 2 ho₂).elim
    rcases principal_add_iff_zero_or_omega_opow.1
        (principal_add_of_principal_mul_opow one_lt_omega ho) with
      (rfl | ⟨b, rfl⟩)
    · left
      simpa using one_le_two
    exact Or.inr ⟨b, rfl⟩
  · rintro (ho₂ | ⟨a, rfl⟩)
    · exact principal_mul_of_le_two ho₂
    · exact principal_mul_omega_opow_opow a
#align ordinal.principal_mul_iff_le_two_or_omega_opow_opow Ordinal.principal_mul_iff_le_two_or_omega_opow_opow

theorem mul_omega_dvd {a : Ordinal} (a0 : 0 < a) (ha : a < omega) : ∀ {b}, omega ∣ b → a * b = b
  | _, ⟨b, rfl⟩ => by rw [← mul_assoc, mul_omega a0 ha]
#align ordinal.mul_omega_dvd Ordinal.mul_omega_dvd

theorem mul_eq_opow_log_succ {a b : Ordinal.{u}} (ha : a ≠ 0) (hb : Principal (· * ·) b)
    (hb₂ : 2 < b) : a * b = (b^succ (log b a)) := by
  apply le_antisymm
  · have hbl := principal_mul_isLimit hb₂ hb
    have := IsNormal.bsup_eq.{u, u} (mul_isNormal (Ordinal.pos_iff_ne_zero.2 ha)) hbl
    dsimp at this
    rw [← this, bsup_le_iff]
    intro c hcb
    have hb₁ : 1 < b := (lt_succ 1).trans (by simpa using hb₂)
    have hbo₀ : (b^b.log a) ≠ 0 := Ordinal.pos_iff_ne_zero.1 (opow_pos _ (zero_lt_one.trans hb₁))
    apply le_trans (mul_le_mul_right' (le_of_lt (lt_mul_succ_div a hbo₀)) c)
    rw [mul_assoc, opow_succ]
    refine' mul_le_mul_left' (le_of_lt (hb (hbl.2 _ _) hcb)) _
    rw [div_lt hbo₀, ← opow_succ]
    exact lt_opow_succ_log_self hb₁ _
  · rw [opow_succ]
    exact mul_le_mul_right' (opow_log_le_self b ha) b
#align ordinal.mul_eq_opow_log_succ Ordinal.mul_eq_opow_log_succ

/-! #### Exponential principal ordinals -/

theorem principal_opow_omega : Principal (·^·) omega := fun a b ha hb =>
  match a, b, lt_omega.1 ha, lt_omega.1 hb with
  | _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ => by
    simp_rw [← nat_cast_opow]
    apply nat_lt_omega
#align ordinal.principal_opow_omega Ordinal.principal_opow_omega

theorem opow_omega {a : Ordinal} (a1 : 1 < a) (h : a < omega) : (a^omega) = omega :=
  le_antisymm
    ((opow_le_of_limit (one_le_iff_ne_zero.1 <| le_of_lt a1) omega_isLimit).2 fun _ hb =>
      (principal_opow_omega h hb).le)
    (right_le_opow _ a1)
#align ordinal.opow_omega Ordinal.opow_omega

end Ordinal


-- Imagen_de_la_imagen_inversa.lean
-- Imagen de la imagen inversa
-- José A. Alonso Jiménez
-- Sevilla, 10 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f '' (f⁻¹' u) ⊆ u
-- ----------------------------------------------------------------------

import data.set.basic
open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  u : set β

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

example : f '' (f⁻¹' u) ⊆ u :=
begin
  intros y h,
  cases h with x h2,
  cases h2 with hx fxy,
  rw ← fxy,
  exact hx,
end

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

example : f '' (f⁻¹' u) ⊆ u :=
begin
  intros y h,
  rcases h with ⟨x, hx, fxy⟩,
  rw ← fxy,
  exact hx,
end

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

example : f '' (f⁻¹' u) ⊆ u :=
begin
  rintros y ⟨x, hx, fxy⟩,
  rw ← fxy,
  exact hx,
end

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

example : f '' (f⁻¹' u) ⊆ u :=
begin
  rintros y ⟨x, hx, rfl⟩,
  exact hx,
end

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

example : f '' (f⁻¹' u) ⊆ u :=
image_preimage_subset f u

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

example : f '' (f⁻¹' u) ⊆ u :=
by simp


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

import algebra.order.ring.defs
import algebra.ring.divisibility
import algebra.order.group.abs

/-!
# Absolute values in linear ordered rings.

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

variables {α : Type*}

section linear_ordered_ring
variables [linear_ordered_ring α] {a b c : α}

@[simp] lemma abs_one : |(1 : α)| = 1 := abs_of_pos zero_lt_one
@[simp] lemma abs_two : |(2 : α)| = 2 := abs_of_pos zero_lt_two

lemma abs_mul (a b : α) : |a * b| = |a| * |b| :=
begin
  rw [abs_eq (mul_nonneg (abs_nonneg a) (abs_nonneg b))],
  cases le_total a 0 with ha ha; cases le_total b 0 with hb hb;
    simp only [abs_of_nonpos, abs_of_nonneg, true_or, or_true, eq_self_iff_true,
      neg_mul, mul_neg, neg_neg, *]
end

/-- `abs` as a `monoid_with_zero_hom`. -/
def abs_hom : α →*₀ α := ⟨abs, abs_zero, abs_one, abs_mul⟩

@[simp] lemma abs_mul_abs_self (a : α) : |a| * |a| = a * a :=
abs_by_cases (λ x, x * x = a * a) rfl (neg_mul_neg a a)

@[simp] lemma abs_mul_self (a : α) : |a * a| = a * a :=
by rw [abs_mul, abs_mul_abs_self]

@[simp] lemma abs_eq_self : |a| = a ↔ 0 ≤ a := by simp [abs_eq_max_neg]

@[simp] lemma abs_eq_neg_self : |a| = -a ↔ a ≤ 0 := by simp [abs_eq_max_neg]

/-- For an element `a` of a linear ordered ring, either `abs a = a` and `0 ≤ a`,
    or `abs a = -a` and `a < 0`.
    Use cases on this lemma to automate linarith in inequalities -/
lemma abs_cases (a : α) : (|a| = a ∧ 0 ≤ a) ∨ (|a| = -a ∧ a < 0) :=
begin
  by_cases 0 ≤ a,
  { left,
    exact ⟨abs_eq_self.mpr h, h⟩ },
  { right,
    push_neg at h,
    exact ⟨abs_eq_neg_self.mpr (le_of_lt h), h⟩ }
end

@[simp] lemma max_zero_add_max_neg_zero_eq_abs_self (a : α) :
  max a 0 + max (-a) 0 = |a| :=
begin
  symmetry,
  rcases le_total 0 a with ha|ha;
  simp [ha],
end

lemma abs_eq_iff_mul_self_eq : |a| = |b| ↔ a * a = b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact (mul_self_inj (abs_nonneg a) (abs_nonneg b)).symm,
end

lemma abs_lt_iff_mul_self_lt : |a| < |b| ↔ a * a < b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b)
end

lemma abs_le_iff_mul_self_le : |a| ≤ |b| ↔ a * a ≤ b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b)
end

lemma abs_le_one_iff_mul_self_le_one : |a| ≤ 1 ↔ a * a ≤ 1 :=
by simpa only [abs_one, one_mul] using @abs_le_iff_mul_self_le α _ a 1

end linear_ordered_ring

section linear_ordered_comm_ring

variables [linear_ordered_comm_ring α] {a b c d : α}

lemma abs_sub_sq (a b : α) : |a - b| * |a - b| = a * a + b * b - (1 + 1) * a * b :=
begin
  rw abs_mul_abs_self,
  simp only [mul_add, add_comm, add_left_comm, mul_comm, sub_eq_add_neg,
    mul_one, mul_neg, neg_add_rev, neg_neg],
end

end linear_ordered_comm_ring

section
variables [ring α] [linear_order α] {a b : α}

@[simp] lemma abs_dvd (a b : α) : |a| ∣ b ↔ a ∣ b :=
by { cases abs_choice a with h h; simp only [h, neg_dvd] }

lemma abs_dvd_self (a : α) : |a| ∣ a :=
(abs_dvd a a).mpr (dvd_refl a)

@[simp] lemma dvd_abs (a b : α) : a ∣ |b| ↔ a ∣ b :=
by { cases abs_choice b with h h; simp only [h, dvd_neg] }

lemma self_dvd_abs (a : α) : a ∣ |a| :=
(dvd_abs a a).mpr (dvd_refl a)

lemma abs_dvd_abs (a b : α) : |a| ∣ |b| ↔ a ∣ b :=
(abs_dvd _ _).trans (dvd_abs _ _)

end


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

import data.list.rotate
import group_theory.perm.support

/-!
# Permutations from a list

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

A list `l : list α` can be interpreted as a `equiv.perm α` where each element in the list
is permuted to the next one, defined as `form_perm`. When we have that `nodup l`,
we prove that `equiv.perm.support (form_perm l) = l.to_finset`, and that
`form_perm l` is rotationally invariant, in `form_perm_rotate`.

When there are duplicate elements in `l`, how and in what arrangement with respect to the other
elements they appear in the list determines the formed permutation.
This is because `list.form_perm` is implemented as a product of `equiv.swap`s.
That means that presence of a sublist of two adjacent duplicates like `[..., x, x, ...]`
will produce the same permutation as if the adjacent duplicates were not present.

The `list.form_perm` definition is meant to primarily be used with `nodup l`, so that
the resulting permutation is cyclic (if `l` has at least two elements).
The presence of duplicates in a particular placement can lead `list.form_perm` to produce a
nontrivial permutation that is noncyclic.
-/

namespace list

variables {α β : Type*}

section form_perm

variables [decidable_eq α] (l : list α)

open equiv equiv.perm

/--
A list `l : list α` can be interpreted as a `equiv.perm α` where each element in the list
is permuted to the next one, defined as `form_perm`. When we have that `nodup l`,
we prove that `equiv.perm.support (form_perm l) = l.to_finset`, and that
`form_perm l` is rotationally invariant, in `form_perm_rotate`.
-/
def form_perm : equiv.perm α :=
(zip_with equiv.swap l l.tail).prod

@[simp] lemma form_perm_nil : form_perm ([] : list α) = 1 := rfl

@[simp] lemma form_perm_singleton (x : α) : form_perm [x] = 1 := rfl

@[simp] lemma form_perm_cons_cons (x y : α) (l : list α) :
  form_perm (x :: y :: l) = swap x y * form_perm (y :: l) :=
prod_cons

lemma form_perm_pair (x y : α) : form_perm [x, y] = swap x y := rfl

variables {l} {x : α}

lemma form_perm_apply_of_not_mem (x : α) (l : list α) (h : x ∉ l) :
  form_perm l x = x :=
begin
  cases l with y l,
  { simp },
  induction l with z l IH generalizing x y,
  { simp },
  { specialize IH x z (mt (mem_cons_of_mem y) h),
    simp only [not_or_distrib, mem_cons_iff] at h,
    simp [IH, swap_apply_of_ne_of_ne, h] }
end

lemma mem_of_form_perm_apply_ne (x : α) (l : list α) : l.form_perm x ≠ x → x ∈ l :=
not_imp_comm.2 $ list.form_perm_apply_of_not_mem _ _

lemma form_perm_apply_mem_of_mem (x : α) (l : list α) (h : x ∈ l) :
  form_perm l x ∈ l :=
begin
  cases l with y l,
  { simpa },
  induction l with z l IH generalizing x y,
  { simpa using h },
  { by_cases hx : x ∈ z :: l,
    { rw [form_perm_cons_cons, mul_apply, swap_apply_def],
      split_ifs;
      simp [IH _ _ hx] },
    { replace h : x = y := or.resolve_right h hx,
      simp [form_perm_apply_of_not_mem _ _ hx, ←h] } }
end

lemma mem_of_form_perm_apply_mem (x : α) (l : list α) (h : l.form_perm x ∈ l) : x ∈ l :=
begin
  cases l with y l,
  { simpa },
  induction l with z l IH generalizing x y,
  { simpa using h },
  { by_cases hx : (z :: l).form_perm x ∈ z :: l,
    { rw [list.form_perm_cons_cons, mul_apply, swap_apply_def] at h,
      split_ifs at h;
      simp [IH _ _ hx] },
    { replace hx := (function.injective.eq_iff (equiv.injective _)).mp
        (list.form_perm_apply_of_not_mem _ _ hx),
      simp only [list.form_perm_cons_cons, hx, equiv.perm.coe_mul, function.comp_app,
        list.mem_cons_iff, swap_apply_def, ite_eq_left_iff] at h,
      simp only [list.mem_cons_iff],
      obtain h | h | h := h;
      { split_ifs at h;
        cc }}}
end

lemma form_perm_mem_iff_mem : l.form_perm x ∈ l ↔ x ∈ l :=
⟨l.mem_of_form_perm_apply_mem x, l.form_perm_apply_mem_of_mem x⟩

@[simp] lemma form_perm_cons_concat_apply_last (x y : α) (xs : list α) :
  form_perm (x :: (xs ++ [y])) y = x :=
begin
  induction xs with z xs IH generalizing x y,
  { simp },
  { simp [IH] }
end

@[simp] lemma form_perm_apply_last (x : α) (xs : list α) :
  form_perm (x :: xs) ((x :: xs).last (cons_ne_nil x xs)) = x :=
begin
  induction xs using list.reverse_rec_on with xs y IH generalizing x;
  simp
end

@[simp] lemma form_perm_apply_nth_le_length (x : α) (xs : list α) :
  form_perm (x :: xs) ((x :: xs).nth_le xs.length (by simp)) = x :=
by rw [nth_le_cons_length, form_perm_apply_last]; refl

lemma form_perm_apply_head (x y : α) (xs : list α) (h : nodup (x :: y :: xs)) :
  form_perm (x :: y :: xs) x = y :=
by simp [form_perm_apply_of_not_mem _ _ h.not_mem]

lemma form_perm_apply_nth_le_zero (l : list α) (h : nodup l) (hl : 1 < l.length) :
  form_perm l (l.nth_le 0 (zero_lt_one.trans hl)) = l.nth_le 1 hl :=
begin
  rcases l with (_|⟨x, _|⟨y, tl⟩⟩),
  { simp },
  { simp },
  { simpa using form_perm_apply_head _ _ _ h }
end

variables (l)

lemma form_perm_eq_head_iff_eq_last (x y : α) :
  form_perm (y :: l) x = y ↔ x = last (y :: l) (cons_ne_nil _ _) :=
iff.trans (by rw form_perm_apply_last) (form_perm (y :: l)).injective.eq_iff

lemma zip_with_swap_prod_support' (l l' : list α) :
  {x | (zip_with swap l l').prod x ≠ x} ≤ l.to_finset ⊔ l'.to_finset :=
begin
  simp only [set.sup_eq_union, set.le_eq_subset],
  induction l with y l hl generalizing l',
  { simp },
  { cases l' with z l',
    { simp },
    { intro x,
      simp only [set.union_subset_iff, mem_cons_iff, zip_with_cons_cons, foldr, prod_cons,
                 mul_apply],
      intro hx,
      by_cases h : x ∈ {x | (zip_with swap l l').prod x ≠ x},
      { specialize hl l' h,
        refine set.mem_union.elim hl (λ hm, _) (λ hm, _);
        { simp only [finset.coe_insert, set.mem_insert_iff, finset.mem_coe, to_finset_cons,
                     mem_to_finset] at hm ⊢,
          simp [hm] } },
      { simp only [not_not, set.mem_set_of_eq] at h,
        simp only [h, set.mem_set_of_eq] at hx,
        rw swap_apply_ne_self_iff at hx,
        rcases hx with ⟨hyz, rfl|rfl⟩;
        simp } } }
end

lemma zip_with_swap_prod_support [fintype α] (l l' : list α) :
  (zip_with swap l l').prod.support ≤ l.to_finset ⊔ l'.to_finset :=
begin
  intros x hx,
  have hx' : x ∈ {x | (zip_with swap l l').prod x ≠ x} := by simpa using hx,
  simpa using zip_with_swap_prod_support' _ _ hx'
end

lemma support_form_perm_le' : {x | form_perm l x ≠ x} ≤ l.to_finset :=
begin
  refine (zip_with_swap_prod_support' l l.tail).trans _,
  simpa [finset.subset_iff] using tail_subset l
end

lemma support_form_perm_le [fintype α] : support (form_perm l) ≤ l.to_finset :=
begin
  intros x hx,
  have hx' : x ∈ {x | form_perm l x ≠ x} := by simpa using hx,
  simpa using support_form_perm_le' _ hx'
end

lemma form_perm_apply_lt (xs : list α) (h : nodup xs) (n : ℕ) (hn : n + 1 < xs.length) :
  form_perm xs (xs.nth_le n ((nat.lt_succ_self n).trans hn)) = xs.nth_le (n + 1) hn :=
begin
  induction n with n IH generalizing xs,
  { simpa using form_perm_apply_nth_le_zero _ h _ },
  { rcases xs with (_|⟨x, _|⟨y, l⟩⟩),
    { simp },
    { simp },
    { specialize IH (y :: l) h.of_cons _,
      { simpa [nat.succ_lt_succ_iff] using hn },
      simp only [swap_apply_eq_iff, coe_mul, form_perm_cons_cons, nth_le],
      generalize_proofs at IH,
      rw [IH, swap_apply_of_ne_of_ne, nth_le];
      { rintro rfl,
        simpa [nth_le_mem _ _ _] using h } } }
end

lemma form_perm_apply_nth_le (xs : list α) (h : nodup xs) (n : ℕ) (hn : n < xs.length) :
  form_perm xs (xs.nth_le n hn) = xs.nth_le ((n + 1) % xs.length)
    (nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
begin
  cases xs with x xs,
  { simp },
  { have : n ≤ xs.length,
    { refine nat.le_of_lt_succ _,
      simpa using hn },
    rcases this.eq_or_lt with rfl|hn',
    { simp },
    { simp [form_perm_apply_lt, h, nat.mod_eq_of_lt, nat.succ_lt_succ hn'] } }
end

lemma support_form_perm_of_nodup' (l : list α) (h : nodup l) (h' : ∀ (x : α), l ≠ [x]) :
  {x | form_perm l x ≠ x} = l.to_finset :=
begin
  apply le_antisymm,
  { exact support_form_perm_le' l },
  { intros x hx,
    simp only [finset.mem_coe, mem_to_finset] at hx,
    obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx,
    rw [set.mem_set_of_eq, form_perm_apply_nth_le _ h],
    intro H,
    rw nodup_iff_nth_le_inj at h,
    specialize h _ _ _ _ H,
    cases (nat.succ_le_of_lt hn).eq_or_lt with hn' hn',
    { simp only [←hn', nat.mod_self] at h,
      refine not_exists.mpr h' _,
      simpa [←h, eq_comm, length_eq_one] using hn' },
    { simpa [nat.mod_eq_of_lt hn'] using h } }
end

lemma support_form_perm_of_nodup [fintype α] (l : list α) (h : nodup l) (h' : ∀ (x : α), l ≠ [x]) :
  support (form_perm l) = l.to_finset :=
begin
  rw ←finset.coe_inj,
  convert support_form_perm_of_nodup' _ h h',
  simp [set.ext_iff]
end

lemma form_perm_rotate_one (l : list α) (h : nodup l) :
  form_perm (l.rotate 1) = form_perm l :=
begin
  have h' : nodup (l.rotate 1),
  { simpa using h },
  ext x,
  by_cases hx : x ∈ l.rotate 1,
  { obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
    rw [form_perm_apply_nth_le _ h', nth_le_rotate l, nth_le_rotate l,
      form_perm_apply_nth_le _ h],
    simp },
  { rw [form_perm_apply_of_not_mem _ _ hx, form_perm_apply_of_not_mem],
    simpa using hx }
end

lemma form_perm_rotate (l : list α) (h : nodup l) (n : ℕ) :
  form_perm (l.rotate n) = form_perm l :=
begin
  induction n with n hn,
  { simp },
  { rw [nat.succ_eq_add_one, ←rotate_rotate, form_perm_rotate_one, hn],
    rwa is_rotated.nodup_iff,
    exact is_rotated.forall l n }
end

lemma form_perm_eq_of_is_rotated {l l' : list α} (hd : nodup l) (h : l ~r l') :
  form_perm l = form_perm l' :=
begin
  obtain ⟨n, rfl⟩ := h,
  exact (form_perm_rotate l hd n).symm
end

lemma form_perm_reverse (l : list α) (h : nodup l) :
  form_perm l.reverse = (form_perm l)⁻¹ :=
begin
  -- Let's show `form_perm l` is an inverse to `form_perm l.reverse`.
  rw [eq_comm, inv_eq_iff_mul_eq_one],
  ext x,
  -- We only have to check for `x ∈ l` that `form_perm l (form_perm l.reverse x)`
  rw [mul_apply, one_apply],
  by_cases hx : x ∈ l,
  swap,
  { rw [form_perm_apply_of_not_mem x l.reverse, form_perm_apply_of_not_mem _ _ hx],
    simpa using hx },
  { obtain ⟨k, hk, rfl⟩ := nth_le_of_mem (mem_reverse.mpr hx),
    rw [form_perm_apply_nth_le l.reverse (nodup_reverse.mpr h),
        nth_le_reverse', form_perm_apply_nth_le _ h, nth_le_reverse'],
    { congr,
      rw [length_reverse, ←nat.succ_le_iff, nat.succ_eq_add_one] at hk,
      cases hk.eq_or_lt with hk' hk',
      { simp [←hk'] },
      { rw [length_reverse, nat.mod_eq_of_lt hk', tsub_add_eq_add_tsub (nat.le_pred_of_lt hk'),
            nat.mod_eq_of_lt],
        { simp },
        { rw tsub_add_cancel_of_le,
          refine tsub_lt_self _ (nat.zero_lt_succ _),
          all_goals { simpa using (nat.zero_le _).trans_lt hk' } } } },
    all_goals { rw [← tsub_add_eq_tsub_tsub, ←length_reverse],
      refine tsub_lt_self _ (zero_lt_one.trans_le (le_add_right le_rfl)),
      exact k.zero_le.trans_lt hk } },
end

lemma form_perm_pow_apply_nth_le (l : list α) (h : nodup l) (n k : ℕ) (hk : k < l.length) :
  (form_perm l ^ n) (l.nth_le k hk) = l.nth_le ((k + n) % l.length)
    (nat.mod_lt _ (k.zero_le.trans_lt hk)) :=
begin
  induction n with n hn,
  { simp [nat.mod_eq_of_lt hk] },
  { simp [pow_succ, mul_apply, hn, form_perm_apply_nth_le _ h, nat.succ_eq_add_one,
          ←nat.add_assoc] }
end

lemma form_perm_ext_iff {x y x' y' : α} {l l' : list α}
  (hd : nodup (x :: y :: l)) (hd' : nodup (x' :: y' :: l')) :
  form_perm (x :: y :: l) = form_perm (x' :: y' :: l') ↔ (x :: y :: l) ~r (x' :: y' :: l') :=
begin
  refine ⟨λ h, _, λ hr, form_perm_eq_of_is_rotated hd hr⟩,
  rw equiv.perm.ext_iff at h,
  have hx : x' ∈ (x :: y :: l),
  { have : x' ∈ {z | form_perm (x :: y :: l) z ≠ z},
    { rw [set.mem_set_of_eq, h x', form_perm_apply_head _ _ _ hd'],
      simp only [mem_cons_iff, nodup_cons] at hd',
      push_neg at hd',
      exact hd'.left.left.symm },
    simpa using support_form_perm_le' _ this },
  obtain ⟨n, hn, hx'⟩ := nth_le_of_mem hx,
  have hl : (x :: y :: l).length = (x' :: y' :: l').length,
  { rw [←dedup_eq_self.mpr hd, ←dedup_eq_self.mpr hd',
        ←card_to_finset, ←card_to_finset],
    refine congr_arg finset.card _,
    rw [←finset.coe_inj, ←support_form_perm_of_nodup' _ hd (by simp),
        ←support_form_perm_of_nodup' _ hd' (by simp)],
    simp only [h] },
  use n,
  apply list.ext_le,
  { rw [length_rotate, hl] },
  { intros k hk hk',
    rw nth_le_rotate,
    induction k with k IH,
    { simp_rw [nat.zero_add, nat.mod_eq_of_lt hn],
      simpa },
    { have : k.succ = (k + 1) % (x' :: y' :: l').length,
      { rw [←nat.succ_eq_add_one, nat.mod_eq_of_lt hk'] },
      simp_rw this,
      rw [←form_perm_apply_nth_le _ hd' k (k.lt_succ_self.trans hk'),
          ←IH (k.lt_succ_self.trans hk), ←h, form_perm_apply_nth_le _ hd],
      congr' 1,
      have h1 : 1 = 1 % (x' :: y' :: l').length := by simp,
      rw [hl, nat.mod_eq_of_lt hk', h1, ←nat.add_mod, nat.succ_add] } }
end

lemma form_perm_apply_mem_eq_self_iff (hl : nodup l) (x : α) (hx : x ∈ l) :
  form_perm l x = x ↔ length l ≤ 1 :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
  rw [form_perm_apply_nth_le _ hl, hl.nth_le_inj_iff],
  cases hn : l.length,
  { exact absurd k.zero_le (hk.trans_le hn.le).not_le },
  { rw hn at hk,
    cases (nat.le_of_lt_succ hk).eq_or_lt with hk' hk',
    { simp [←hk', nat.succ_le_succ_iff, eq_comm] },
    { simpa [nat.mod_eq_of_lt (nat.succ_lt_succ hk'), nat.succ_lt_succ_iff]
        using k.zero_le.trans_lt hk' } }
end

lemma form_perm_apply_mem_ne_self_iff (hl : nodup l) (x : α) (hx : x ∈ l) :
  form_perm l x ≠ x ↔ 2 ≤ l.length :=
begin
  rw [ne.def, form_perm_apply_mem_eq_self_iff _ hl x hx, not_le],
  exact ⟨nat.succ_le_of_lt, nat.lt_of_succ_le⟩
end

lemma mem_of_form_perm_ne_self (l : list α) (x : α) (h : form_perm l x ≠ x) :
  x ∈ l :=
begin
  suffices : x ∈ {y | form_perm l y ≠ y},
  { rw ←mem_to_finset,
    exact support_form_perm_le' _ this },
  simpa using h
end

lemma form_perm_eq_self_of_not_mem (l : list α) (x : α) (h : x ∉ l) :
  form_perm l x = x :=
by_contra (λ H, h $ mem_of_form_perm_ne_self _ _ H)

lemma form_perm_eq_one_iff (hl : nodup l) :
  form_perm l = 1 ↔ l.length ≤ 1 :=
begin
  cases l with hd tl,
  { simp },
  { rw ←form_perm_apply_mem_eq_self_iff _ hl hd (mem_cons_self _ _),
    split,
    { simp {contextual := tt} },
    { intro h,
      simp only [(hd :: tl).form_perm_apply_mem_eq_self_iff hl hd (mem_cons_self hd tl),
                 add_le_iff_nonpos_left, length, nonpos_iff_eq_zero, length_eq_zero] at h,
      simp [h] } }
end

lemma form_perm_eq_form_perm_iff {l l' : list α} (hl : l.nodup) (hl' : l'.nodup) :
  l.form_perm = l'.form_perm ↔ l ~r l' ∨ l.length ≤ 1 ∧ l'.length ≤ 1 :=
begin
  rcases l with (_ | ⟨x, _ | ⟨y, l⟩⟩),
  { suffices : l'.length ≤ 1 ↔ l' = nil ∨ l'.length ≤ 1,
    { simpa [eq_comm, form_perm_eq_one_iff, hl, hl', length_eq_zero] },
    refine ⟨λ h, or.inr h, _⟩,
    rintro (rfl | h),
    { simp },
    { exact h } },
  { suffices : l'.length ≤ 1 ↔ [x] ~r l' ∨ l'.length ≤ 1,
    { simpa [eq_comm, form_perm_eq_one_iff, hl, hl', length_eq_zero, le_rfl] },
    refine ⟨λ h, or.inr h, _⟩,
    rintro (h | h),
    { simp [←h.perm.length_eq] },
    { exact h } },
  { rcases l' with (_ | ⟨x', _ | ⟨y', l'⟩⟩),
    { simp [form_perm_eq_one_iff, hl, -form_perm_cons_cons] },
    { suffices : ¬ (x :: y :: l) ~r [x'],
      { simp [form_perm_eq_one_iff, hl, -form_perm_cons_cons] },
      intro h,
      simpa using h.perm.length_eq },
    { simp [-form_perm_cons_cons, form_perm_ext_iff hl hl'] } }
end

lemma form_perm_zpow_apply_mem_imp_mem (l : list α) (x : α) (hx : x ∈ l) (n : ℤ) :
  ((form_perm l) ^ n) x ∈ l :=
begin
  by_cases h : (l.form_perm ^ n) x = x,
  { simpa [h] using hx },
  { have : x ∈ {x | (l.form_perm ^ n) x ≠ x} := h,
    rw ←set_support_apply_mem at this,
    replace this := set_support_zpow_subset _ _ this,
    simpa using support_form_perm_le' _ this }
end

lemma form_perm_pow_length_eq_one_of_nodup (hl : nodup l) :
  (form_perm l) ^ (length l) = 1 :=
begin
  ext x,
  by_cases hx : x ∈ l,
  { obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
    simp [form_perm_pow_apply_nth_le _ hl, nat.mod_eq_of_lt hk] },
  { have : x ∉ {x | (l.form_perm ^ l.length) x ≠ x},
    { intros H,
      refine hx _,
      replace H := set_support_zpow_subset l.form_perm l.length H,
      simpa using support_form_perm_le' _ H },
    simpa }
end

end form_perm

end list


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

import data.polynomial.unit_trinomial
import ring_theory.polynomial.gauss_lemma
import tactic.linear_combination

/-!
# Irreducibility of Selmer Polynomials

This file proves irreducibility of the Selmer polynomials `X ^ n - X - 1`.

## Main results

- `polynomial.selmer_irreducible`: The Selmer polynomials `X ^ n - X - 1` are irreducible.

TODO: Show that the Selmer polynomials have full Galois group.
-/

namespace polynomial
open_locale polynomial

variables {n : ℕ}

lemma X_pow_sub_X_sub_one_irreducible_aux (z : ℂ) : ¬ (z ^ n = z + 1 ∧ z ^ n + z ^ 2 = 0) :=
begin
  rintros ⟨h1, h2⟩,
  replace h3 : z ^ 3 = 1,
  { linear_combination (1 - z - z ^ 2 - z ^ n) * h1 + (z ^ n - 2) * h2 }, -- thanks polyrith!
  have key : z ^ n = 1 ∨ z ^ n = z ∨ z ^ n = z ^ 2,
  { rw [←nat.mod_add_div n 3, pow_add, pow_mul, h3, one_pow, mul_one],
    have : n % 3 < 3 := nat.mod_lt n zero_lt_three,
    interval_cases n % 3; simp only [h, pow_zero, pow_one, eq_self_iff_true, or_true, true_or] },
  have z_ne_zero : z ≠ 0 :=
  λ h, zero_ne_one ((zero_pow zero_lt_three).symm.trans (show (0 : ℂ) ^ 3 = 1, from h ▸ h3)),
  rcases key with key | key | key,
  { exact z_ne_zero (by rwa [key, self_eq_add_left] at h1) },
  { exact one_ne_zero (by rwa [key, self_eq_add_right] at h1) },
  { exact z_ne_zero (pow_eq_zero (by rwa [key, add_self_eq_zero] at h2)) },
end

lemma X_pow_sub_X_sub_one_irreducible (hn1 : n ≠ 1) : irreducible (X ^ n - X - 1 : ℤ[X]) :=
begin
  by_cases hn0 : n = 0,
  { rw [hn0, pow_zero, sub_sub, add_comm, ←sub_sub, sub_self, zero_sub],
    exact associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X },
  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩,
  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 :=
    by simp only [trinomial, C_neg, C_1]; ring,
  rw hp,
  apply is_unit_trinomial.irreducible_of_coprime' ⟨0, 1, n, zero_lt_one, hn, -1, -1, 1, rfl⟩,
  rintros z ⟨h1, h2⟩,
  apply X_pow_sub_X_sub_one_irreducible_aux z,
  rw [trinomial_mirror zero_lt_one hn (-1 : ℤˣ).ne_zero (1 : ℤˣ).ne_zero] at h2,
  simp_rw [trinomial, aeval_add, aeval_mul, aeval_X_pow, aeval_C] at h1 h2,
  simp_rw [units.coe_neg, units.coe_one, map_neg, map_one] at h1 h2,
  replace h1 : z ^ n = z + 1 := by linear_combination h1,
  replace h2 := mul_eq_zero_of_left h2 z,
  rw [add_mul, add_mul, add_zero, mul_assoc (-1 : ℂ), ←pow_succ', nat.sub_add_cancel hn.le] at h2,
  rw h1 at h2 ⊢,
  exact ⟨rfl, by linear_combination -h2⟩,
end

lemma X_pow_sub_X_sub_one_irreducible_rat (hn1 : n ≠ 1) : irreducible (X ^ n - X - 1 : ℚ[X]) :=
begin
  by_cases hn0 : n = 0,
  { rw [hn0, pow_zero, sub_sub, add_comm, ←sub_sub, sub_self, zero_sub],
    exact associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X },
  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 :=
  by simp only [trinomial, C_neg, C_1]; ring,
  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩,
  have h := (is_primitive.int.irreducible_iff_irreducible_map_cast _).mp
    (X_pow_sub_X_sub_one_irreducible hn1),
  { rwa [polynomial.map_sub, polynomial.map_sub, polynomial.map_pow, polynomial.map_one,
      polynomial.map_X] at h },
  { exact hp.symm ▸ (trinomial_monic zero_lt_one hn).is_primitive },
end

end polynomial


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

-/

import data.fintype.basic
import combinatorics.fibonacci

def nat.succ_emb : ℕ ↪ ℕ :=
  ⟨nat.succ, λ i j e, nat.succ.inj e⟩

def fin.succ_emb (n : ℕ) : (fin n) ↪ (fin n.succ) :=
  ⟨fin.succ, λ i j e, fin.succ_inj.mp e⟩

def fin.val_emb (n : ℕ) : (fin n) ↪ ℕ :=
  ⟨coe, λ i j e, fin.eq_of_veq e⟩

namespace combinatorics

def shift {n : ℕ} (s : finset (fin n)) : finset (fin n.succ) :=
 s.map (fin.succ_emb n)

/- Given a set s ⊆ {0,..,n}, we can shift it to the left
   to get a set (unshift s) = {i : i + 1 ∈ s} ⊆ {0,..,n-1}
-/
def unshift {n : ℕ} (s : finset (fin n.succ)) : finset (fin n) :=
 finset.univ.filter (λ a, a.succ ∈ s)

lemma mem_shift {n : ℕ} (s : finset (fin n)) (a : fin n.succ) :
 a ∈ shift s ↔ ∃ b : fin n, b ∈ s ∧ b.succ = a :=
begin
 rw[shift],split,
 {intro a_in_shift,
  rcases finset.mem_map.mp a_in_shift with ⟨b,⟨b_in_s,e⟩⟩,
  use b,
  exact ⟨b_in_s,e⟩,
 },{
  rintro ⟨b,⟨b_in_s,e⟩⟩,
  exact finset.mem_map.mpr ⟨b,⟨b_in_s,e⟩⟩,
 }
end

lemma zero_not_mem_shift {n : ℕ} (s : finset (fin n)) :
 (0 : (fin n.succ)) ∉ shift s :=
begin
 intro h0,
 rcases ((mem_shift s) 0).mp h0 with ⟨⟨b,hb⟩,⟨b_in_s,e⟩⟩,
 cases e
end

lemma succ_mem_shift_iff {n : ℕ} (s : finset (fin n)) (a : fin n) :
 a.succ ∈ shift s ↔ a ∈ s :=
begin
 rw[mem_shift s a.succ],
 split,{
   rintro ⟨b,⟨b_in_s,u⟩⟩,
   rw[(fin.succ_inj.mp u).symm],
   exact b_in_s,
 },{
   intro a_in_s,use a,exact ⟨a_in_s,rfl⟩,
 }
end

lemma mem_unshift {n : ℕ} (s : finset (fin n.succ)) (a : fin n) :
 a ∈ unshift s ↔ a.succ ∈ s :=
begin
 rw[unshift,finset.mem_filter],
 split,
 {intro h,exact h.right},
 {intro h,exact ⟨finset.mem_univ a,h⟩ }
end

lemma unshift_shift {n : ℕ} (s : finset (fin n)) :
 unshift (shift s) = s :=
begin
 ext,rw[mem_unshift (shift s) a],rw[succ_mem_shift_iff],
end

lemma unshift_insert {n : ℕ} (s : finset (fin n.succ)) :
 unshift (insert (0 : (fin n.succ)) s) = unshift s :=
begin
 ext ⟨i,hi⟩,rw[mem_unshift,mem_unshift,finset.mem_insert],
 split,
 {intro h,rcases h with h0 | h1,
  {cases h0},
  {exact h1} },
 {exact λ h,or.inr h}
end

lemma shift_unshift0 {n : ℕ} (s : finset (fin n.succ))
  (h : (0 : (fin n.succ)) ∉ s) : shift (unshift s) = s :=
begin
 ext ⟨_ | a,a_is_lt⟩,
 { have e : (0 : fin n.succ) = ⟨0,a_is_lt⟩ := fin.eq_of_veq rfl,
   rw[← e],simp only[zero_not_mem_shift,h] },
 { let b : fin n := ⟨a,nat.lt_of_succ_lt_succ a_is_lt⟩,
   have e : b.succ = ⟨a.succ,a_is_lt⟩ :=
    by { apply fin.eq_of_veq, refl, },
   rw[← e,succ_mem_shift_iff (unshift s) b,mem_unshift s b] }
end

lemma shift_unshift1 {n : ℕ} (s : finset (fin n.succ))
 (h : (0 : fin n.succ) ∈ s) : insert (0 : fin n.succ) (shift (unshift s)) = s :=
begin
  ext ⟨_ | a,a_is_lt⟩;
  rw[finset.mem_insert],
  { have e : (0 : fin n.succ) = ⟨0,a_is_lt⟩ := fin.eq_of_veq rfl,
    rw [← e], simp only[h,eq_self_iff_true,true_or] },
  { let b : fin n := ⟨a,nat.lt_of_succ_lt_succ a_is_lt⟩,
    have e : b.succ = ⟨a.succ,a_is_lt⟩ :=
      by { apply fin.eq_of_veq,refl, },
    rw [← e, succ_mem_shift_iff (unshift s) b, mem_unshift s b],
    split,
    { rintro (u0 | u1),
      { cases fin.veq_of_eq u0 },
      { exact u1 } } ,
    { intro h, right, exact h } }
end

lemma shift_card {n : ℕ} (s : finset (fin n)) : (shift s).card = s.card :=
 by { apply finset.card_map, }

lemma finset_fin_zero_empty (s : finset (fin 0)) : s = ∅ :=
  finset.eq_empty_of_forall_not_mem (λ i, fin.elim0 i)

lemma finset_fin_zero_card (s : finset (fin 0)) : s.card = 0 :=
  by { rw [finset_fin_zero_empty s, finset.card_empty] }

lemma unshift_card0 {n : ℕ} {s : finset (fin n.succ)}
  (h : (0 : fin n.succ) ∉ s) : s.card = (unshift s).card :=
begin
  let t := unshift s,
  change s.card = t.card,
  have : s = (shift t) := (shift_unshift0 s h).symm,
  rw [this, shift_card]
end

lemma unshift_card1 {n : ℕ} {s : finset (fin n.succ)}
  (h : (0 : fin n.succ) ∈ s) : s.card = (unshift s).card.succ :=
begin
  let t := unshift s,
  change s.card = t.card.succ,
  have : s = insert 0 (shift t) := (shift_unshift1 s h).symm,
  rw [this],
  rw [finset.card_insert_of_not_mem (zero_not_mem_shift t), shift_card]
end

lemma unshift_card {n : ℕ} (s : finset (fin n.succ)) :
  s.card =
   (if (0 : fin n.succ) ∈ s then (unshift s).card.succ else (unshift s).card) :=
begin
  split_ifs, apply unshift_card1 h, apply unshift_card0 h
end

def emb_nat_finset {n : ℕ} : (finset (fin n)) ↪ finset ℕ  :=
  ⟨λ s, s.map ⟨coe, λ i j e, fin.eq_of_veq e⟩,
   λ s t e, finset.map_inj.mp e⟩

lemma emb_nat_finset_shift {n : ℕ} (s : finset (fin n)) :
  emb_nat_finset.to_fun (shift s) =
   (emb_nat_finset.to_fun s).map nat.succ_emb :=
begin
  ext i, rw[emb_nat_finset, finset.mem_map, finset.mem_map],
  split,
  { rintro ⟨⟨j,j_is_lt⟩,⟨hm,he⟩⟩, change j = i at he,
    rcases (mem_shift s ⟨j,_⟩).mp hm with ⟨⟨k,k_is_lt⟩,⟨hk,hsk⟩⟩,
    use k,
    have : k ∈ emb_nat_finset.to_fun s :=
      by { rw [emb_nat_finset, finset.mem_map], use ⟨k,k_is_lt⟩, use hk, refl },
    use this,
    exact (fin.veq_of_eq hsk).trans he},
  { rintro ⟨j,⟨hj,he⟩⟩, change j.succ = i at he,
    rcases finset.mem_map.mp hj with ⟨⟨k,k_is_lt⟩,⟨hk,hv⟩⟩,
    change k = j at hv,
    use fin.succ ⟨k,k_is_lt⟩,
    use (succ_mem_shift_iff s ⟨k,k_is_lt⟩).mpr hk,
    change k.succ = i,
    rw [hv, he] }
end

lemma emb_nat_finset_unshift {n : ℕ} (s : finset (fin n.succ)) :
  emb_nat_finset.to_fun (unshift s) =
   (finset.range n).filter (λ i, i.succ ∈ emb_nat_finset.to_fun s) :=
begin
  ext i,
  rw [finset.mem_filter, finset.mem_range,
      emb_nat_finset, emb_nat_finset,
      finset.mem_map, finset.mem_map],
  split,
  { rintro ⟨⟨j,j_is_lt⟩,⟨hm,he⟩⟩, change j = i at he, rw[mem_unshift] at hm,
    split,
    { rw[← he], exact j_is_lt },
    { use fin.succ ⟨j,j_is_lt⟩, use hm, change j.succ = i.succ, rw[he]} },
  { rintro ⟨hi,⟨⟨j,j_is_lt⟩,⟨hm,he⟩⟩⟩, change j = i.succ at he,
    let i0 : fin n := ⟨i,hi⟩,
    have hj : (⟨j,j_is_lt⟩ : (fin n.succ)) = i0.succ := fin.eq_of_veq he,
    rw [hj] at hm,
    use i0, use (mem_unshift s i0).mpr hm, refl }
end

end combinatorics


theorem smaller_than2 {a b x y: ℕ}
 (h1: a ≤ x)
 (h2: b ≤ y) :
 (a + b ≤ x + y) := begin
  exact add_le_add h1 h2
 end

theorem smaller_than3 {a b c x y z: ℕ}
 (h1: a ≤ x)
 (h2: b ≤ y)
 (h3: c ≤ z) :
  a + (b + c) ≤ x + (y + z) := begin
  generalize hbc : b + c = bc,
  generalize hyz : y + z = yz,
  refine add_le_add h1 _,
  rw [←hbc, ←hyz],
  refine add_le_add h2 h3,
 end


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

Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/
import topology.uniform_space.cauchy topology.uniform_space.separation

open filter
variables {α : Type*} [uniform_space α]

/-In a separated space, a complete set is closed -/
lemma is_closed_of_is_complete [separated α] {s : set α} (h : is_complete s) : is_closed s :=
is_closed_iff_nhds.2 $ λ a ha, begin
  let f := nhds a ⊓ principal s,
  have : cauchy f := cauchy_downwards (cauchy_nhds) ha (lattice.inf_le_left),
  rcases h f this (lattice.inf_le_right) with ⟨y, ys, fy⟩,
  rwa (tendsto_nhds_unique ha lattice.inf_le_left fy : a = y)
end


variables p q : Prop

#check p → q → p ∧ q
#check ¬p -> p ↔ false
#check p ∨ q → q ∨ p

namespace conjunction

    example (hp : p) (hq : q) : p ∧ q := and.intro hp hq
    #check assume (hp : p) (hq : q), and.intro hp hq

    example (h : p ∧ q) : p := and.elim_left h
    example (h : p ∧ q) : q := and.elim_right h

    -- Equivilant
    example (h : p ∧ q) : q ∧ p := and.intro (and.right h) (and.left h)
    example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

    variables (hp : p) (hq : q)
    #check (⟨hp, hq⟩ : p ∧ q)

end conjunction

namespace disjunction
    example (hp : p) : p ∨ q := or.intro_left q hp
    example (hq : q) : p ∨ q := or.intro_right p hq

    -- Equivilant
    example (h : p ∨ q) : q ∨ p :=
        or.elim h
            (assume hp : p,
                show q ∨ p, from or.intro_right q hp)
            $ assume hq : q,
                 or.intro_left p hq
    example (h : p ∨ q) : q ∨ p :=
        or.elim h (λ hp : p, or.inr hp) (λ hq : q, or.inl hq)
    example (h : p ∨ q) : q ∨ p :=
        h.elim (assume hp : p, or.inr hp) (assume hq : q, or.inl hq)

    namespace neg
        example (hpq : p → q) (hnq : ¬q) : ¬p :=
        λ hp : p,
        show false, from hnq $ hpq hp

        -- Equivilant
        example (hp : p) (hnp : ¬p) : q := false.elim $ hnp hp
        example (hp : p) (hnp : ¬p) : q := absurd hp hnp
    end neg

    theorem and_swap : p ∧ q ↔ q ∧ p :=
    iff.intro
        (λ h : p ∧ q,
            show q ∧ p, from ⟨h.right, h.left⟩)
        (λ h : q ∧ p,
            show p ∧ q, from ⟨h.right, h.left⟩)
    #check and_swap p q

    variable h : p ∧ q
    variable j : q ∧ p
    example : q ∧ p := iff.mp (and_swap p q) h
    example : p ∧ q := iff.mpr (and_swap p q) j

    theorem short_and_swap : p ∧ q ↔ q ∧ p :=
    ⟨λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩⟩
    example (h : p ∧ q) : q ∧ p := (short_and_swap p q).mp h

end disjunction