-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (P → Q) ↔ ¬ P ∨ Q
-- ----------------------------------------------------------------------

import tactic

open_locale classical

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

example
  (P Q : Prop)
  : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
  { intro h1,
    by_cases h2: P,
    { right,
      apply h1,
      exact h2 },
    { left,
      exact h2 }},
  { intros h3 h4,
    cases h3,
    { contradiction },
    { assumption }},
end

-- Prueba
-- ======

/-
P Q : Prop
⊢ P → Q ↔ ¬P ∨ Q
  >> split,
| 2 goals
| P Q : Prop
| ⊢ (P → Q) → ¬P ∨ Q
|   >> { intro h1,
| h1 : P → Q
| ⊢ ¬P ∨ Q
|   >>   by_cases h2: P,
| | 2 goals
| | P Q : Prop,
| | h1 : P → Q,
| | h2 : P
| | ⊢ ¬P ∨ Q
| |   >>   { right,
| | ⊢ Q
| |   >>     apply h1,
| | ⊢ P
| |   >>     exact h2 },
| P Q : Prop,
| h1 : P → Q,
| h2 : ¬P
| ⊢ ¬P ∨ Q
|   >>   { left,
| ⊢ ¬P
|   >>     exact h2 }},
P Q : Prop
⊢ ¬P ∨ Q → P → Q
  >> { intros h3 h4,
h3 : ¬P ∨ Q,
h4 : P
⊢ Q
  >>   cases h3,
| 2 goals
| case or.inl
| P Q : Prop,
| h4 : P,
| h3 : ¬P
| ⊢ Q
|   >>   { contradiction },
case or.inr
P Q : Prop,
h4 : P,
h3 : Q
⊢ Q
  >>   { assumption }},
no goals
-/

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

example
  (P Q : Prop)
  : (P → Q) ↔ ¬ P ∨ Q :=
imp_iff_not_or

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

example
  (P Q : Prop)
  : (P → Q) ↔ ¬ P ∨ Q :=
by tauto


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 2 : `true` and `false`

We learn about the `true` and `false` propositions.

## Tactics you will need

To solve the levels on this sheet you will need to know all previous
tactics, plus the following two new ones:

* `trivial`
* `exfalso`

### The `trivial` tactic

If your goal is `⊢ true` then `trivial,` will solve it.

### The `exfalso` tactic

The tactic `exfalso,` turns any goal `⊢ P` into `⊢ false`.
This is mathematically valid because `false` implies any goal.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : true :=
begin
  trivial,
end

example : true → true :=
begin
  intro h,
  trivial,
end

example : false → true :=
begin
  trivial,
end

example : false → false :=
begin
  trivial,
end

example : (true → false) → false :=
begin
  intro h,
  exact h trivial,                    /-remember such usage-/
end

example : false → P :=
begin
  trivial,
end

example : true → false → true → false → true → false :=
begin
  intros h1 h2 h3 h4 h5,
  exfalso,
  exact h2,
end

example : P → ((P → false) → false) :=
begin
  intro hP,
  intro hPf,
  exact hPf hP,
end

example : (P → false) → P → Q :=
begin
  intros hPf hP,
  exfalso,
  exact hPf hP,
end

example : (true → false) → P :=
begin
  intro h,
  exfalso,
  exact h trivial,
end

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

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *the same thing* and can be used interchangeably. You can change
from one to the other for free.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `change` (optional)
* `by_contra`
* `by_cases`

### The `change` tactic

The `change` tactic changes a goal to a goal which
is *equal to it by definition*. The example you need to know
is that `¬ P` and `P → false` are equal by definition.

If your goal is `⊢ ¬ P` then `change P → false,` will
change it to `P → false`. Similarly if you have a hypothesis
`h : ¬ P` then `change P → false at h,` will change it to `h : P → false`.

Note that this tactic is just for psychological purposes. If you finish
a proof which uses this tactic, try commenting out the `change` lines
and note that it doesn't break.

### The `by_contra` tactic

If your goal is `⊢ P` and you want to prove it by contradiction,
`by_contra h,` will change the goal to `false` and add a hypothesis
`h : ¬ P`.

### The `by_cases` tactic

If `P : Prop` is a true-false statement then `by_cases hP : P,`
turns your goal into two goals, one with hypothesis `hP : P`
and the other with hypothesis `hP : ¬ P`.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

example : ¬ P → (P → false) :=
begin
  intro h,
  change P → false at h,
  trivial,
end

example : ¬ true → false :=
begin
  intro h,
  change true → false at h,
  exact h trivial,
end

example : false → ¬ true :=
begin
  intro h,
  change true → false,
  intro ht,
  exact h,
end

example : ¬ false → true :=
begin
  intro h,
  change false → false at h,
  trivial,
end

example : true → ¬ false :=
begin
  intro h,
  change false → false,
  trivial,
end

example : false → ¬ P :=
begin
  intro h,
  change P → false,
  intro P,
  exact h,
end

example : P → ¬ P → false :=
begin
  intros hP hP',
  change P → false at hP',
  exact hP' hP,
end

example : P → ¬ (¬ P) :=
begin
  intro hP,
  change ¬P → false,
  intro hP',
  change P → false at hP',
  exact hP' hP,
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  intro hPQ,
  intro hQ,
  change Q → false at hQ,
  change P → false,
  intro hP,
  apply hQ,
  exact hPQ hP,
end

example : ¬ ¬ false → false :=
begin
  by_cases false,
  {intro h,
    change ¬ false → false at h,
    exact h,},
  {intro h,
  change ¬ false → false at h,
  exact h_1 h,},
end

example : ¬ ¬ P → P :=
begin
  by_cases P,
  {intro h,
  change ¬ P → false at h,
  exact h},
  {intro h,
  change ¬ P → false at h,
  exfalso,
  exact h_1 h,},
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  intro h,
  intro hP,
  by_contra hP,
  have hP': ¬ P, apply h hP,
  trivial,
end


/-
Copyright (c) 2018  Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Chris Hughes, Michael Howes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.hom
import Mathlib.data.equiv.mul_add_aut
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

/-!
# Conjugacy of group elements

See also `mul_aut.conj` and `quandle.conj`.
-/

/-- We say that `a` is conjugate to `b` if for some `c` we have `c * a * c⁻¹ = b`. -/
def is_conj {α : Type u} [group α] (a : α) (b : α) :=
  ∃ (c : α), c * a * (c⁻¹) = b

theorem is_conj_refl {α : Type u} [group α] (a : α) : is_conj a a := sorry

theorem is_conj_symm {α : Type u} [group α] {a : α} {b : α} : is_conj a b → is_conj b a := sorry

theorem is_conj_trans {α : Type u} [group α] {a : α} {b : α} {c : α} : is_conj a b → is_conj b c → is_conj a c := sorry

@[simp] theorem is_conj_one_right {α : Type u} [group α] {a : α} : is_conj 1 a ↔ a = 1 := sorry

@[simp] theorem is_conj_one_left {α : Type u} [group α] {a : α} : is_conj a 1 ↔ a = 1 :=
  iff.trans { mp := is_conj_symm, mpr := is_conj_symm } is_conj_one_right

@[simp] theorem conj_inv {α : Type u} [group α] {a : α} {b : α} : b * a * (b⁻¹)⁻¹ = b * (a⁻¹) * (b⁻¹) :=
  Eq.symm (mul_equiv.map_inv (coe_fn mul_aut.conj b) a)

@[simp] theorem conj_mul {α : Type u} [group α] {a : α} {b : α} {c : α} : b * a * (b⁻¹) * (b * c * (b⁻¹)) = b * (a * c) * (b⁻¹) :=
  Eq.symm (mul_equiv.map_mul (coe_fn mul_aut.conj b) a c)

theorem conj_injective {α : Type u} [group α] {x : α} : function.injective fun (g : α) => x * g * (x⁻¹) :=
  mul_equiv.injective (coe_fn mul_aut.conj x)

@[simp] theorem is_conj_iff_eq {α : Type u_1} [comm_group α] {a : α} {b : α} : is_conj a b ↔ a = b := sorry

protected theorem monoid_hom.map_is_conj {α : Type u} {β : Type v} [group α] [group β] (f : α →* β) {a : α} {b : α} : is_conj a b → is_conj (coe_fn f a) (coe_fn f b) := sorry


/- Yair Gueta : 208624908 : t4
    Exercise 4
-/

---- Question 1

--- Chapter 3:
namespace C3
variables p q r : Prop
-- First proof first try:
example : p ∨ false ↔ p :=
begin
  simp,
end

-- First proof 2nd try:
example : p ∨ false ↔ p :=
begin
  apply iff.intro,
    intro h,
      apply or.elim h,
      intro hp,
      exact hp,
    intro hfalse,
    apply false.elim,
    exact hfalse,
  intro hp,
  exact or.inl hp,
end

example : p ∧ false ↔ false :=
begin
  apply iff.intro,
    intro h,
    exact h.right,
  intro hf,
  exact false.elim hf,
end

example : (p → q) → (¬q → ¬p) :=
begin
  intro h,
  intro hnq,
  apply not.intro,
  intro hp,
  exact absurd (h hp) hnq
end

end C3

--- Chapter 4:
namespace C4
open classical
variables (α : Type*) (p q : α → Prop)
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) :=
begin
  intro ha,
  apply iff.intro,
    intro h,
    exact h ha,
  intro h,
  intro haa,
  exact h,
end

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
begin
  apply iff.intro,
    intro h,
    apply or.elim (em r),
      intro hr,
      exact or.inr hr,
    intro hnr,
    left,
      intro l,
      cases (h l) with a b,
        exact a,
      show p l, from absurd b hnr,
  intro h,
  intro hx,
  cases h with h₁ h₂,
    exact or.inl (h₁ hx),
  exact or.inr h₂,
end

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
begin
  apply iff.intro,
    intro h,
    intro hr,
    intro hx,
    exact (h hx) hr,
  intro h,
  intro hx,
  intro hr,
  exact (h hr) hx,
end

end C4

--- Question 2:
example (p q r : Prop) (hp : p) :
(p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by {repeat {split}, repeat{left, assumption}, repeat{right, left, assumption}, repeat{right, right, assumption}}


def hello := "world"

universe v u u₁ u₂
#check Sort 0
class Category (Ob : Type u) where
  hom : Ob → Ob → Sort v
  id : ∀ A : Ob, hom A A
  comp : ∀ {A B C : Ob}, (hom A B) → (hom B C) → (hom A C)
  comp_assoc : ∀ {A B C D : Ob} (f : hom A B) (g : hom B C) (h : hom C D),
    comp f (comp g h) = comp (comp f g) h
  l_unit : ∀ {A B : Ob} (f : hom A B), comp (id A) f = f
  r_unit : ∀ {A B : Ob} (f : hom A B), comp f (id B) = f

export Category (hom id comp)

structure functor (C : Type u₁) (D : Type u₂) [Category C] [Category D] where
  ob_map : C → D
  hom_map : ∀ {A B : C}, (hom A B) → (hom (ob_map A) (ob_map B))
  preserve_units : ∀ {A : C}, hom_map (Category.id A) = Category.id (ob_map A)
  preserve_comp : ∀ {X Y Z : C} (f : hom X Y) (g : hom Y Z),
    hom_map (comp f g) = comp (hom_map f) (hom_map g)

#check functor

section CategoryOne

inductive One where
  | one : One

inductive OneId where
  | mk : One → One → OneId

instance : ToString One where
  toString one := "•"

instance : ToString OneId where
  toString _ := "id•"

open One

instance : Category One where
  hom (X Y : One) := OneId
  id _ := OneId.mk one one
  comp := fun (OneId.mk one one) (OneId.mk one one) => OneId.mk one one
  comp_assoc f g h := by simp
  l_unit f := by simp
  r_unit f := by simp

#eval Category.id one
#eval comp (Category.id one) (Category.id one)

def endo_one : functor One One := {
  ob_map := fun _ => one,
  hom_map := fun _ => OneId.mk one one,
  preserve_units := by
    simp
    rfl
  preserve_comp := by
    simp
    intros
    rfl
}

#check endo_one
#eval endo_one.ob_map one

def functor_to_one (C : Type u) [Category C] : (functor C One) := {
  ob_map := fun _ => one,
  hom_map := fun _ => OneId.mk one one
  preserve_units := by
    simp
    rfl
  preserve_comp := by
    simp
    intros
    rfl
}

end CategoryOne

-- The category of Lean types (in universe 1) and functions between them
section LeanCat

instance : Category Type where
  hom (X Y : Type) := X → Y
  id A := fun (x : A) => x
  comp f g := fun x => g (f x)
  comp_assoc f g h := by simp
  l_unit f := by simp
  r_unit f := by simp

def list_length (l : List Nat) : Nat :=
  match l with
  | x::xs => 1 + (list_length xs)
  | nil => 0

#eval list_length [1,2,3,4]

def double (x : Nat) : Nat := x * 2

#eval (Category.id Nat) 7
#eval (Category.id (List Nat)) [1,2,3]

def doubleH := Category.comp (Category.id Nat) double
def lengthH := Category.comp (Category.id (List Nat)) list_length

#check comp lengthH doubleH
#eval (comp lengthH doubleH) [1,2,3,4]

def F := functor_to_one Type
#check F

#eval F.ob_map Nat
#eval F.hom_map lengthH

end LeanCat

section CatMonoid

class Monoid (α : Type u) where
  unit : α
  op : α → α → α
  op_assoc: ∀ a b c : α, op a (op b c) = op (op a b) c
  l_unit : ∀ a : α, op unit a = a
  r_unit : ∀ a : α, op a unit = a

instance cat_of_monoid (α : Type u) (M : Monoid α) : Category Unit where
  hom := fun (_ _ : Unit) => α
  id := fun (x : Unit) => M.unit
  comp := fun (f g : α) => M.op f g
  comp_assoc := by simp; intros; apply M.op_assoc
  l_unit := by simp; intros; apply M.l_unit
  r_unit := by simp; intros; apply M.r_unit

instance NatsUnderPlus : Monoid Nat where
  unit := 0
  op x y := x + y
  l_unit x := by simp
  r_unit x := by simp
  op_assoc a b c := by
    simp
    rw [Nat.add_assoc]

def NatsUnderPlusCat := cat_of_monoid Nat NatsUnderPlus

-- TODO: Figure out how to evaluate homs in these categories

end CatMonoid

section PreorderCats

class Preorder (Ob : Type u) where
  leq : Ob → Ob → Prop
  leq_ref : ∀ a : Ob, leq a a
  leq_trans : ∀ a b c : Ob, (leq a b) → (leq b c) → (leq a c)

-- Construct a thin category from a preorder
instance cat_of_preorder (α : Type u) (P : Preorder α) : Category.{0} α where
  hom := P.leq
  id a := by apply P.leq_ref
  comp := by apply P.leq_trans
  comp_assoc := by intros; rfl
  l_unit := by intros; rfl
  r_unit := by intros; rfl

-- Examples

instance NatPreorder : Preorder Nat where
  leq := Nat.le
  leq_ref := by simp
  leq_trans := by
    simp
    apply Nat.le_trans

instance NatMod4Preorder : Preorder Nat where
  leq a b := a / 4 ≤ b / 4
  leq_ref := by simp
  leq_trans a b c := by
    simp
    apply Nat.le_trans

-- Top and Bottom

structure bottom (C : Type u) (P : Preorder C) where
  el : C
  is_bottom : ∀ x : C, P.leq el x

structure top (C : Type u) (P : Preorder C) where
  el : C
  is_top : ∀ x : C, P.leq x el

-- Can set el to 0-3 and this will hold because 0-3 are isomorphic in this preorder
def nat_bottom : bottom Nat NatMod4Preorder := {
  el := 0
  is_bottom := by
    intro x
    apply Nat.zero_le
}

#check nat_bottom

-- Meets and joins. TODO: restate these as degenerate cases of products/co-products in thin cats

structure join (C : Type u) (a b : C) (P : Preorder C) where
  j : C
  upper_bound : (P.leq a j) ∧ (P.leq b j)
  least: ∀ x : C, (P.leq a x) → (P.leq b x) → (P.leq j x)

structure has_all_joins (C : Type u) (P : Preorder C) where
  pf : ∀ (a b : C), ∃ (j : C),
    (P.leq a j) ∧ (P.leq b j) ∧ (∀ x : C, (P.leq a x) → (P.leq b x) → (P.leq j x))

structure meet (C : Type u) (P : Preorder C) (a b : C) where
  m : C
  lower_bound : (P.leq m a) ∧ (P.leq m b)
  greatest: ∀ x : C, (P.leq x a) → (P.leq x b) → (P.leq x m)

structure has_all_meets (C : Type u) (P : Preorder C) where
  pf : ∀ (a b : C), ∃ (m : C),
    (P.leq m a ∧ P.leq m b) ∧ (∀ x : C, (P.leq x a) → (P.leq x b) → (P.leq x m))

-- examples

def nat_meet (a b : Nat) : meet Nat NatPreorder a b := {
  m := if a ≤ b then a else b
  lower_bound := by
    apply And.intro
    case left =>
      split
      case inl h =>
        apply Nat.le_refl
      case inr h =>
        rw [Nat.not_le_eq] at h
        revert h
        apply Nat.le_of_succ_le
    case right =>
      split
      case inl h =>
        exact h
      case inr h =>
        apply Nat.le_refl
  greatest := by
    intros x xle_a xle_b
    split
    case inl h =>
      exact xle_a
    case inr h =>
      exact xle_b
}

#eval (nat_meet 5 6).m

theorem nat_all_meets : has_all_meets Nat NatPreorder := {
  pf := by
    intros a b
    let m := nat_meet a b
    exists m.m
    apply And.intro
    case left =>
      exact m.lower_bound
    case right =>
      exact m.greatest
}

-- TODO: get rid of sorrys :(
def natmod4_meet (a b : Nat) : meet Nat NatMod4Preorder a b := {
  m := if a ≤ b then a else b
  lower_bound := by
    apply And.intro
    case left =>
      split
      case inl h =>
        apply Nat.le_refl
      case inr h =>
        show b / 4 ≤ a / 4
        rw [Nat.not_le_eq] at h
        apply Nat.le_of_succ_le
        rw [← Nat.succ_eq_add_one] at h
        sorry
    case right =>
      split
      case inl h =>
        show a / 4 ≤ b / 4
        sorry
      case inr h =>
        sorry
  greatest := by
    intros x xle_a xle_b
    split
    case inl h =>
      exact xle_a
    case inr h =>
      exact xle_b
}

theorem natmod4_all_meets : has_all_meets Nat NatMod4Preorder := {
  pf := by
    intros a b
    let m := natmod4_meet a b
    exists m.m
    apply And.intro
    case left =>
      exact m.lower_bound
    case right =>
      exact m.greatest
}

end PreorderCats

-- Category of Binary relations between types
section CatRel

def rel := Type u
--instance : inhabited rel := by unfold rel;

instance Rel : Category (Type u) where
  hom A B := A → B → Prop
  id A := fun (a b : A) => a = b
  comp := fun R S a c => ∃ b, R a b ∧ S b c
  comp_assoc := by
    simp
    intro A B C D f g h
    --have a : A. TODO: I think this proof requires that types are inhabited
    sorry
  l_unit := by
    simp
    intro A B f
    sorry
  r_unit := by
    sorry

end CatRel

-- Heyting algebra of propositional provability
section IPL

inductive prop where
  | T : prop
  | F : prop
  | p_or : prop → prop → prop
  | p_and : prop → prop → prop
  | p_impl : prop → prop → prop

open prop
def Γ_t := List (prop × Bool)
section
set_option hygiene false
local notation:10 Γ " ⊢ " p " : " b => judgement Γ p b

inductive judgement : Γ_t → prop → Bool → Prop where
  | true_i : ∀ Γ : Γ_t, Γ ⊢ T : true
  | and_i : ∀ (Γ : Γ_t) (A B : prop),
      (Γ ⊢ A : true) → (Γ ⊢ B : true) → (Γ ⊢ (p_and A B) : true)
  | and_e1 : ∀ (Γ : Γ_t) (A B : prop),
      (Γ ⊢ (p_and A B) : true) → (Γ ⊢ A : true)
  | and_e2 : ∀ (Γ : Γ_t) (A B : prop),
      (Γ ⊢ (p_and A B) : true) → (Γ ⊢ B : true)
  | impl_i : ∀ (Γ : Γ_t) (A B : prop),
      ((A, true)::Γ ⊢ B : true) → (Γ ⊢ (p_impl A B) : true)
  | impl_e : ∀ (Γ : Γ_t) (A B : prop),
      (Γ ⊢ (p_impl A B) : true) → (Γ ⊢ A : true) → (Γ ⊢ B : true)
  | false_e : ∀ (Γ : Γ_t) (A : prop), (Γ ⊢ F : true) → (Γ ⊢ A : true)
  | or_i1 : ∀ (Γ : Γ_t) (A B : prop), (Γ ⊢ A : true) → (Γ ⊢ (p_or A B) : true)
  | or_i2 : ∀ (Γ : Γ_t) (A B : prop), (Γ ⊢ B : true) → (Γ ⊢ (p_or A B) : true)
  | or_e : ∀ (Γ : Γ_t) (A B C : prop),
      (Γ ⊢ (p_or A B) : true) →
      ((A, true)::Γ ⊢ C : true) →
      ((B, true)::Γ ⊢ C : true) → (Γ ⊢ C : true)

  -- structural rules
  | entailment_refl : ∀ (Γ : Γ_t) (A : prop), (A, true)::Γ ⊢ A : true
  --TODO: Use this more proper definition of transitivity (needs weakening to apply)
  --| entailment_trans : ∀ (Γ₁ Γ₂ : Γ_t) (A B : prop),
      --(Γ₁ ⊢ A : true) → ((A, true)::Γ₂ ⊢ B : true) → ((List.append Γ₁ Γ₂) ⊢ B : true)
  | entailment_trans : ∀ (Γ : Γ_t) (A B C : prop),
      ((A, true)::Γ ⊢ B : true) → ((B, true)::Γ ⊢ C : true) → ((A, true)::Γ ⊢ C : true)

end

notation:10 Γ " ⊢ " p " : " b => judgement Γ p b

axiom impl_inversion : ∀ (Γ : Γ_t) (A B : prop),
  (Γ ⊢ (p_impl A B) : true) → ((A, true)::Γ ⊢ B : true)

instance : Preorder prop where
  leq A B := ∀ Γ : Γ_t, Γ ⊢ (p_impl A B) : true
  leq_ref := by
    intro A Γ
    apply judgement.impl_i
    apply judgement.entailment_refl
  leq_trans := by
    intro A B C h1 h2 Γ
    apply judgement.impl_i
    let h1 := impl_inversion Γ A B (h1 Γ)
    let h2 := impl_inversion Γ B C (h2 Γ)
    apply judgement.entailment_trans Γ A B C h1 h2

end IPL

section AlgCorrectness

def list_max (l : List Nat) : Nat :=
  List.foldl (fun (max el : Nat) => if max ≤ el then el else max) 0 l

#eval list_max [5,7,12,2,4]

end AlgCorrectness


theorem Eq.comm {α : Sort _} {a b : α} : a = b ↔ b = a := ⟨Eq.symm, Eq.symm⟩

theorem Or.assoc : p ∨ q ∨ r ↔ (p ∨ q) ∨ r :=
  ⟨fun pq_r => Or.elim pq_r
    (fun x => Or.inl (Or.inl x))
    (fun qr => Or.elim qr
      (fun x => Or.inl (Or.inr x))
      (fun x => Or.inr x)),
  fun pq_r => Or.elim pq_r
    (fun pq => Or.elim pq
      (fun x => Or.inl x)
      (fun x => Or.inr (Or.inl x)))
    (fun x => Or.inr (Or.inr x))⟩

theorem Or.comm : p ∨ q → q ∨ p := fun h => Or.elim h Or.inr Or.inl

theorem Or.comm' : p ∨ q ↔ q ∨ p := ⟨Or.comm, Or.comm⟩

theorem Or.left_comm (h : a ∨ (b ∨ c)) : b ∨ (a ∨ c) :=
  Or.elim h (fun h => Or.inr (Or.inl h)) (Or.elim · Or.inl (fun h => Or.inr (Or.inr h)))

theorem Or.left_comm' : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) :=
  ⟨Or.left_comm, Or.left_comm⟩

theorem And.assoc : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  ⟨fun ⟨⟨ha, hb⟩, hc⟩ => ⟨ha, ⟨hb, hc⟩⟩, fun ⟨ha, ⟨hb, hc⟩⟩ => ⟨⟨ha, hb⟩, hc⟩⟩

theorem And.comm : a ∧ b → b ∧ a := fun ⟨p, q⟩ => ⟨q, p⟩

theorem And.comm' : a ∧ b ↔ b ∧ a := ⟨And.comm, And.comm⟩

theorem And.left_comm : a ∧ (b ∧ c) → b ∧ (a ∧ c) :=
  fun ⟨ha, hb, hc⟩ => ⟨hb, ha, hc⟩

theorem And.imp (hac : a → c) (hbd : b → d) (hab : a ∧ b) : c ∧ d :=
  ⟨hac hab.left, hbd hab.right⟩

theorem And.imp_left (h : a → b) : a ∧ c → b ∧ c :=
  And.imp h id

theorem And.imp_right (h : a → b) : c ∧ a → c ∧ b :=
  And.imp id h

theorem Or.resolve_left {a b : Prop} (h : a ∨ b) (na : ¬ a) : b :=
  Or.elim h (fun ha => absurd ha na) id

theorem Or.neg_resolve_left {a b : Prop} (h : ¬ a ∨ b) (ha : a) : b :=
  Or.elim h (fun na => absurd ha na) id

theorem Or.resolve_right {a b : Prop} (h : a ∨ b) (nb : ¬ b) : a :=
  Or.elim h id (fun hb => absurd hb nb)

theorem Or.neg_resolve_right {a b : Prop} (h : a ∨ ¬ b) (hb : b) : a :=
  Or.elim h id (fun nb => absurd hb nb)

theorem Or.imp (h₂ : a → c) (h₃ : b → d) : a ∨ b → c ∨ d :=
  Or.rec (fun h => Or.inl (h₂ h)) (fun h => Or.inr (h₃ h))

theorem Or.imp_left (h : a → b) : a ∨ c → b ∨ c :=
  Or.imp h id

theorem Or.imp_right (h : a → b) : c ∨ a → c ∨ b :=
  Or.imp id h

theorem Exists.imp {p q : α → Prop} (h : ∀ a, (p a → q a)) (p : ∃ a, p a) : ∃ a, q a :=
  Exists.elim p (fun a hp => ⟨a, h a hp⟩)

theorem Iff.or (h₁ : a ↔ b) (h₂ : c ↔ d) : a ∨ c ↔ b ∨ d :=
  ⟨fun h => Or.imp h₁.mp h₂.mp h, fun h => Or.imp h₁.mpr h₂.mpr h⟩

theorem Iff.and (h₁ : a ↔ b) (h₂ : c ↔ d) : a ∧ c ↔ b ∧ d :=
  ⟨fun h => And.imp h₁.mp h₂.mp h, fun h => And.imp h₁.mpr h₂.mpr h⟩

namespace M4R

  theorem and_or_distrib_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
    ⟨fun ⟨ha, hbc⟩ => hbc.imp (And.intro ha ·) (And.intro ha ·),
      Or.rec (And.imp_right Or.inl) (And.imp_right Or.inr)⟩

  theorem or_and_distrib_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) :=
    (And.comm'.trans and_or_distrib_left).trans (And.comm'.or And.comm')

  theorem or_and_distrib_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
    ⟨Or.rec (fun ha => And.intro (Or.inl ha) (Or.inl ha)) (And.imp Or.inr Or.inr),
    And.rec (Or.rec ((fun h _ => h) ∘ Or.inl) (Or.imp_right ∘ And.intro))⟩

  theorem and_or_distrib_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) :=
    (Or.comm'.trans or_and_distrib_left).trans (Or.comm'.and Or.comm')

  @[simp] theorem exists_imp_distrib {p : α → Prop} : ((∃ x, p x) → b) ↔ ∀ x, p x → b :=
    ⟨fun h x hpx => h ⟨x, hpx⟩, fun h ⟨x, hpx⟩ => h x hpx⟩

  theorem not_exists {p : α → Prop} : (¬ ∃ x, p x) ↔ ∀ x, ¬ p x :=
    exists_imp_distrib

  theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
    Iff.intro (fun h ha hb => h ⟨ha, hb⟩) (fun h ⟨ha, hb⟩ => h ha hb)

  @[simp] theorem not_and : ¬ (a ∧ b) ↔ (a → ¬ b) := and_imp

  theorem or_iff_right_of_imp (ha : a → b) : (a ∨ b) ↔ b :=
    ⟨Or.rec ha id, Or.inr⟩

  theorem or_iff_left_of_imp (hb : b → a) : (a ∨ b) ↔ a :=
    ⟨Or.rec id hb, Or.inl⟩

  open Classical

  @[simp] theorem not_and_iff_or_not : ¬(p ∧ q) ↔ ¬p ∨ ¬q := Decidable.not_and_iff_or_not p q

  @[simp] theorem not_or_iff_and_not : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
    ⟨fun h => ⟨fun ha => h (Or.inl ha), fun hb => h (Or.inr hb)⟩, fun ⟨h₁, h₂⟩ h => Or.elim h h₁ h₂⟩

  theorem or_iff_not_imp_left : a ∨ b ↔ (¬ a → b) :=
    ⟨Or.resolve_left, fun h => dite _ Or.inl (Or.inr ∘ h)⟩

  theorem or_iff_not_imp_right : a ∨ b ↔ (¬ b → a) :=
    Or.comm'.trans or_iff_not_imp_left

  @[simp] theorem of_not_not : ¬ ¬ p → p := Decidable.of_not_not

  theorem iff_not_not : ¬ ¬ p ↔ p := ⟨of_not_not, fun _ _ => by contradiction⟩

  theorem not_imp_symm (h : ¬a → b) (hb : ¬b) : a := byContradiction (hb ∘ h)

  theorem iff_not_comm : (a ↔ ¬ b) ↔ (b ↔ ¬ a) :=
    ⟨fun h =>
      ⟨fun hb ha => absurd hb (h.mp ha),
      fun ha => of_not_not (mt h.mpr ha)⟩,
    fun h =>
      ⟨fun ha hb => absurd ha (h.mp hb),
      fun hb => of_not_not (mt h.mpr hb)⟩⟩

  theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) :=
    ⟨fun h hb ha => absurd hb (h ha), fun h ha hb => absurd ha (h hb)⟩

  theorem not_forall {p : α → Prop} : (¬ ∀ x, p x) ↔ ∃ x, ¬ p x :=
    ⟨by apply not_imp_symm; intro nE x; apply not_imp_symm _ nE; exact fun h => ⟨x, h⟩,
    fun ⟨x, hn⟩ hA => hn (hA x)⟩

  @[simp] theorem not_iff_not : (¬p ↔ ¬q) ↔ (p ↔ q) :=
    have h : ∀ p q, (p ↔ q) → (¬ p ↔ ¬ q) := fun p q h => ⟨mt h.mpr, mt h.mp⟩
    ⟨by
      have := h (¬p) (¬q)
      simp only [iff_not_not] at this
      exact this, h p q⟩

  theorem iff_of_true (ha : a) (hb : b) : a ↔ b :=
    ⟨fun _ => hb, fun _ => ha⟩

  theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b :=
    ⟨fun h => absurd h ha, fun h => absurd h hb⟩

  theorem eq_self_iff_true (a : α) : a = a ↔ True :=
    ⟨fun _ => trivial, fun _ => rfl⟩

  theorem forall_true_iff : α → True ↔ True :=
    ⟨fun _ => trivial, fun _ _ => trivial⟩

  theorem forall_true_iff' {p : α → Prop} (h : ∀ a, p a ↔ True) : (∀ a, p a) ↔ True :=
    ⟨fun _ => trivial, fun t a => (h a).mpr t⟩

  @[simp] theorem forall_2_true_iff {β : α → Sort _} : (∀ a, β a → True) ↔ True :=
    forall_true_iff' fun _ => forall_true_iff

  @[simp] theorem forall_3_true_iff {β : α → Sort _} {γ : ∀ a, β a → Sort _} :
    (∀ (a : α) (b : β a), γ a b → True) ↔ True :=
      forall_true_iff' fun _ => forall_2_true_iff

  @[simp] theorem not_and_self (a : Prop) : (¬a ∧ a) ↔ False :=
    ⟨fun h => h.left h.right, fun h => False.rec (fun _ => ¬a ∧ a) h⟩

  @[simp] theorem and_not_self (a : Prop) : (a ∧ ¬a) ↔ False := by
    rw [And.comm']; exact not_and_self a

  @[simp] theorem and_self (a : Prop) : a ∧ a ↔ a :=
    ⟨And.left, fun h => ⟨h, h⟩⟩

  theorem funext_iff {β : α → Sort _} {f₁ f₂ : ∀ (x : α), β x} : (∀ x, f₁ x = f₂ x) ↔ f₁ = f₂ :=
    ⟨funext, congrFun⟩

  theorem propext_iff {a b : Prop} : (a ↔ b) ↔ a = b :=
    ⟨propext, fun h => h ▸ Iff.rfl⟩

  theorem forall_congr' {p q : α → Prop} (h : ∀ a, p a ↔ q a) : (∀ a, p a) ↔ (∀ a, q a) :=
    propext_iff.mpr (forall_congr fun a => propext (h a))

end M4R

@[simp] theorem Quotient.eq [r : Setoid α] {x y : α} : Quotient.mk x = Quotient.mk y ↔ x ≈ y :=
  ⟨Quotient.exact, Quotient.sound⟩

@[simp] protected theorem Subtype.exists {p : α → Prop} {q : {a // p a} → Prop} : (∃ x, q x) ↔ (∃ a b, q ⟨a, b⟩) :=
  ⟨fun ⟨⟨a, b⟩, h⟩ => ⟨a, b, h⟩, fun ⟨a, b, h⟩ => ⟨⟨a, b⟩, h⟩⟩

def Option.guard (p : α → Prop) [DecidablePred p] (a : α) : Option α :=
  if p a then some a else none


/-
Copyright (c) 2021 Stuart Presnell. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stuart Presnell
-/
import data.nat.prime
import data.finsupp.multiset
import algebra.big_operators.finsupp
import tactic.linarith
import tactic.interval_cases

/-!
# Prime factorizations

 `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`.  For example, since 2000 = 2^4 * 5^3,
  * `factorization 2000 2` is 4
  * `factorization 2000 5` is 3
  * `factorization 2000 k` is 0 for all other `k : ℕ`.

## TODO

* As discussed in this Zulip thread:
https://leanprover.zulipchat.com/#narrow/stream/217875/topic/Multiplicity.20in.20the.20naturals
We have lots of disparate ways of talking about the multiplicity of a prime
in a natural number, including `factors.count`, `padic_val_nat`, `multiplicity`,
and the material in `data/pnat/factors`.  Move some of this material to this file,
prove results about the relationships between these definitions,
and (where appropriate) choose a uniform canonical way of expressing these ideas.

* Moreover, the results here should be generalised to an arbitrary unique factorization monoid
with a normalization function, and then deduplicated.  The basics of this have been started in
`ring_theory/unique_factorization_domain`.

* Extend the inductions to any `normalization_monoid` with unique factorization.

-/

open nat finset list finsupp
open_locale big_operators

namespace nat

/-- `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`. -/
noncomputable def factorization (n : ℕ) : ℕ →₀ ℕ := (n.factors : multiset ℕ).to_finsupp

/-! ### Basic facts about factorization -/

@[simp] lemma factorization_prod_pow_eq_self {n : ℕ} (hn : n ≠ 0) : n.factorization.prod pow = n :=
begin
  simp only [←prod_to_multiset, factorization, multiset.coe_prod, multiset.to_finsupp_to_multiset],
  exact prod_factors hn,
end

/-- We can write both `n.factorization p` and `n.factors.count p` to represent the power
of `p` in the factorization of `n`: we declare the former to be the simp-normal form.
However, since `factorization` is a finsupp it's noncomputable.  This theorem can also
be used in reverse to compute values of `factorization n p` when required. -/
@[simp] lemma factors_count_eq {n p : ℕ} : n.factors.count p = n.factorization p :=
by simp [factorization]

lemma eq_of_factorization_eq {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0)
  (h : ∀ p : ℕ, a.factorization p = b.factorization p) : a = b :=
eq_of_perm_factors ha hb (by simpa only [list.perm_iff_count, factors_count_eq] using h)

/-- Every nonzero natural number has a unique prime factorization -/
lemma factorization_inj : set.inj_on factorization { x : ℕ | x ≠ 0 } :=
λ a ha b hb h, eq_of_factorization_eq ha hb (λ p, by simp [h])

@[simp] lemma factorization_zero : factorization 0 = 0 :=
by simp [factorization]

@[simp] lemma factorization_one : factorization 1 = 0 :=
by simp [factorization]

/-- The support of `n.factorization` is exactly `n.factors.to_finset` -/
@[simp] lemma support_factorization {n : ℕ} : n.factorization.support = n.factors.to_finset :=
by simpa [factorization, multiset.to_finsupp_support]

lemma factor_iff_mem_factorization {n p : ℕ} : p ∈ n.factorization.support ↔ p ∈ n.factors :=
by simp only [support_factorization, list.mem_to_finset]

lemma prime_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : p.prime :=
prime_of_mem_factors (factor_iff_mem_factorization.mp hp)

lemma pos_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : 0 < p :=
prime.pos (prime_of_mem_factorization hp)

lemma le_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ≤ n :=
le_of_mem_factors (factor_iff_mem_factorization.mp h)

lemma factorization_eq_zero_of_non_prime (n p : ℕ) (hp : ¬p.prime) : n.factorization p = 0 :=
not_mem_support_iff.1 (mt prime_of_mem_factorization hp)

lemma prime.factorization_pos_of_dvd {n p : ℕ} (hp : p.prime) (hn : n ≠ 0) (h : p ∣ n) :
  0 < n.factorization p :=
by rwa [←factors_count_eq, count_pos, mem_factors_iff_dvd hn hp]

/-- The only numbers with empty prime factorization are `0` and `1` -/
lemma factorization_eq_zero_iff (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1 :=
by simp [factorization, add_equiv.map_eq_zero_iff, multiset.coe_eq_zero]

/-- For nonzero `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
@[simp] lemma factorization_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization = a.factorization + b.factorization :=
by { ext p, simp only [add_apply, ←factors_count_eq,
                       perm_iff_count.mp (perm_factors_mul ha hb) p, count_append] }

lemma factorization_mul_support {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  ext q,
  simp only [finset.mem_union, factor_iff_mem_factorization],
  exact mem_factors_mul ha hb
end

/-- For any `p`, the power of `p` in `n^k` is `k` times the power in `n` -/
@[simp] lemma factorization_pow (n k : ℕ) :
  factorization (n^k) = k • n.factorization :=
begin
  induction k with k ih, { simp },
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  rw [pow_succ, factorization_mul hn (pow_ne_zero _ hn), ih, succ_eq_one_add, add_smul, one_smul],
end

/-- The only prime factor of prime `p` is `p` itself, with multiplicity `1` -/
@[simp] lemma prime.factorization {p : ℕ} (hp : prime p) :
  p.factorization = single p 1 :=
begin
  ext q,
  rw [←factors_count_eq, factors_prime hp, single_apply, count_singleton', if_congr eq_comm];
  refl,
end

/-- For prime `p` the only prime factor of `p^k` is `p` with multiplicity `k` -/
lemma prime.factorization_pow {p k : ℕ} (hp : prime p) :
  factorization (p ^ k) = single p k :=
by simp [hp]

/-- If the factorization of `n` contains just one number `p` then `n` is a power of `p` -/
lemma eq_pow_of_factorization_eq_single {n p k : ℕ} (hn : n ≠ 0)
  (h : n.factorization = finsupp.single p k) : n = p ^ k :=
by { rw [←nat.factorization_prod_pow_eq_self hn, h], simp }

/-- If a product over `n.factorization` doesn't use the multiplicities of the prime factors
then it's equal to the corresponding product over `n.factors.to_finset` -/
lemma prod_factorization_eq_prod_factors {n : ℕ} {β : Type*} [comm_monoid β] (f : ℕ → β) :
  n.factorization.prod (λ p k, f p) = ∏ p in n.factors.to_finset, (f p) :=
by { apply prod_congr support_factorization, simp }

/-- For any `p : ℕ` and any function `g : α → ℕ` that's non-zero on `S : finset α`,
the power of `p` in `S.prod g` equals the sum over `x ∈ S` of the powers of `p` in `g x`.
Generalises `factorization_mul`, which is the special case where `S.card = 2` and `g = id`. -/
lemma factorization_prod {α : Type*} {S : finset α} {g : α → ℕ} (hS : ∀ x ∈ S, g x ≠ 0) :
  (S.prod g).factorization = S.sum (λ x, (g x).factorization) :=
begin
  classical,
  ext p,
  apply finset.induction_on' S, { simp },
  { intros x T hxS hTS hxT IH,
    have hT : T.prod g ≠ 0 := prod_ne_zero_iff.mpr (λ x hx, hS x (hTS hx)),
    simp [prod_insert hxT, sum_insert hxT, ←IH, factorization_mul (hS x hxS) hT] }
end

/-! ### Equivalence between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/

/-- Any finsupp `f : ℕ →₀ ℕ` whose support is in the primes is equal to the factorization of
the product `∏ (a : ℕ) in f.support, a ^ f a`. -/
lemma prod_pow_factorization_eq_self {f : ℕ →₀ ℕ} (hf : ∀ (p : ℕ), p ∈ f.support → prime p) :
  (f.prod pow).factorization = f :=
begin
  have h : ∀ x : ℕ, x ∈ f.support → x ^ f x ≠ 0 := λ p hp, pow_ne_zero _ (prime.ne_zero (hf p hp)),
  simp only [finsupp.prod, factorization_prod h],
  nth_rewrite_rhs 0 (sum_single f).symm,
  exact sum_congr rfl (λ p hp, prime.factorization_pow (hf p hp)),
end

lemma eq_factorization_iff {n : ℕ} {f : ℕ →₀ ℕ} (hn : n ≠ 0) (hf : ∀ p ∈ f.support, prime p) :
  f = n.factorization ↔ f.prod pow = n :=
⟨λ h, by rw [h, factorization_prod_pow_eq_self hn],
 λ h, by rw [←h, prod_pow_factorization_eq_self hf]⟩

/-- The equiv between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/
noncomputable
def factorization_equiv : ℕ+ ≃ {f : ℕ →₀ ℕ | ∀ p ∈ f.support, prime p} :=
{ to_fun    := λ ⟨n, hn⟩, ⟨n.factorization, λ _, prime_of_mem_factorization⟩,
  inv_fun   := λ ⟨f, hf⟩, ⟨f.prod pow,
    prod_pow_pos_of_zero_not_mem_support (λ H, not_prime_zero (hf 0 H))⟩,
  left_inv  := λ ⟨x, hx⟩, subtype.ext $ factorization_prod_pow_eq_self hx.ne.symm,
  right_inv := λ ⟨f, hf⟩, subtype.ext $ prod_pow_factorization_eq_self hf }

lemma factorization_equiv_apply (n : ℕ+) : (factorization_equiv n).1 = n.1.factorization :=
by { cases n, refl }

lemma factorization_equiv_inv_apply {f : ℕ →₀ ℕ} (hf : ∀ p ∈ f.support, prime p) :
  (factorization_equiv.symm ⟨f, hf⟩).1 = f.prod pow := rfl

/-! ### Factorization and divisibility -/

lemma dvd_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ∣ n :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  simp [←mem_factors_iff_dvd hn (prime_of_mem_factorization h), factor_iff_mem_factorization.mp h],
end

lemma pow_factorization_dvd (n p : ℕ) : p ^ n.factorization p ∣ n :=
begin
  by_cases hp : p.prime, swap, { simp [factorization_eq_zero_of_non_prime n p hp] },
  rw ←factors_count_eq,
  apply dvd_of_factors_subperm (pow_ne_zero _ hp.ne_zero),
  rw [hp.factors_pow, list.subperm_ext_iff],
  intros q hq,
  simp [list.eq_of_mem_repeat hq],
end

lemma pow_succ_factorization_not_dvd {n p : ℕ} (hn : n ≠ 0) (hp : p.prime) :
  ¬ p ^ (n.factorization p + 1) ∣ n :=
begin
  intro h,
  have := factors_sublist_of_dvd h hn,
  rw [hp.factors_pow, ←le_count_iff_repeat_sublist, factors_count_eq] at this,
  linarith
end

lemma factorization_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  d.factorization ≤ n.factorization ↔ d ∣ n :=
begin
  split,
  { intro hdn,
    set K := n.factorization - d.factorization with hK,
    use K.prod pow,
    rw [←factorization_prod_pow_eq_self hn, ←factorization_prod_pow_eq_self hd,
        ←finsupp.prod_add_index' pow_zero pow_add, hK, add_tsub_cancel_of_le hdn] },
  { rintro ⟨c, rfl⟩, rw factorization_mul hd (right_ne_zero_of_mul hn), simp },
end

lemma factorization_le_factorization_mul_left {a b : ℕ} (hb : b ≠ 0) :
  a.factorization ≤ (a * b).factorization :=
begin
  rcases eq_or_ne a 0 with rfl | ha, { simp },
  rw [factorization_le_iff_dvd ha $ mul_ne_zero ha hb],
  exact dvd.intro b rfl
end

lemma factorization_le_factorization_mul_right {a b : ℕ} (ha : a ≠ 0) :
  b.factorization ≤ (a * b).factorization :=
by { rw mul_comm, apply factorization_le_factorization_mul_left ha }

lemma prime.pow_dvd_iff_le_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) :
  p ^ k ∣ n ↔ k ≤ n.factorization p :=
by rw [←factorization_le_iff_dvd (pow_pos pp.pos k).ne' hn, pp.factorization_pow, single_le_iff]

lemma prime.pow_dvd_iff_dvd_pow_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) :
  p ^ k ∣ n ↔ p ^ k ∣ p ^ n.factorization p :=
by rw [pow_dvd_pow_iff_le_right pp.one_lt, pp.pow_dvd_iff_le_factorization hn]

lemma exists_factorization_lt_of_lt {a b : ℕ} (ha : a ≠ 0) (hab : a < b) :
  ∃ p : ℕ, a.factorization p < b.factorization p :=
begin
  have hb : b ≠ 0 := (ha.bot_lt.trans hab).ne',
  contrapose! hab,
  rw [←finsupp.le_def, factorization_le_iff_dvd hb ha] at hab,
  exact le_of_dvd ha.bot_lt hab,
end

@[simp] lemma factorization_div {d n : ℕ} (h : d ∣ n) :
  (n / d).factorization = n.factorization - d.factorization :=
begin
  rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp h] },
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  apply add_left_injective d.factorization,
  simp only,
  rw [tsub_add_cancel_of_le $ (nat.factorization_le_iff_dvd hd hn).mpr h,
      ←nat.factorization_mul (nat.div_pos (nat.le_of_dvd hn.bot_lt h) hd.bot_lt).ne' hd,
      nat.div_mul_cancel h],
end

lemma dvd_iff_div_factorization_eq_tsub (d n : ℕ) (hd : d ≠ 0) (hdn : d ≤ n) :
  d ∣ n ↔ (n / d).factorization = n.factorization - d.factorization :=
begin
  refine ⟨factorization_div, _⟩,
  rcases eq_or_lt_of_le hdn with rfl | hd_lt_n, { simp },
  have h1 : n / d ≠ 0 := λ H, nat.lt_asymm hd_lt_n ((nat.div_eq_zero_iff hd.bot_lt).mp H),
  intros h,
  rw dvd_iff_le_div_mul n d,
  by_contra h2,
  cases (exists_factorization_lt_of_lt (mul_ne_zero h1 hd) (not_le.mp h2)) with p hp,
  rwa [factorization_mul h1 hd, add_apply, ←lt_tsub_iff_right, h, tsub_apply,
    lt_self_iff_false] at hp
end

lemma dvd_iff_prime_pow_dvd_dvd {n d : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  d ∣ n ↔ ∀ p k : ℕ, prime p → p ^ k ∣ d → p ^ k ∣ n :=
begin
  refine ⟨λ h p k _ hpkd, dvd_trans hpkd h, _⟩,
  rw [←factorization_le_iff_dvd hd hn, finsupp.le_def],
  intros h p,
  by_cases pp : prime p, swap, { simp [factorization_eq_zero_of_non_prime d p pp] },
  rw ←pp.pow_dvd_iff_le_factorization hn,
  exact h p _ pp (pow_factorization_dvd _ _)
end

lemma prod_prime_factors_dvd (n : ℕ) : (∏ (p : ℕ) in n.factors.to_finset, p) ∣ n :=
begin
  by_cases hn : n = 0, { subst hn, simp },
  simpa [prod_factors hn] using multiset.to_finset_prod_dvd_prod (n.factors : multiset ℕ),
end

lemma factorization_gcd {a b : ℕ} (ha_pos : a ≠ 0) (hb_pos : b ≠ 0) :
  (gcd a b).factorization = a.factorization ⊓ b.factorization :=
begin
  let dfac := a.factorization ⊓ b.factorization,
  let d := dfac.prod pow,
  have dfac_prime : ∀ (p : ℕ), p ∈ dfac.support → prime p,
  { intros p hp,
    have : p ∈ a.factors ∧ p ∈ b.factors := by simpa using hp,
    exact prime_of_mem_factors this.1 },
  have h1 : d.factorization = dfac := prod_pow_factorization_eq_self dfac_prime,
  have hd_pos : d ≠ 0 := (factorization_equiv.inv_fun ⟨dfac, dfac_prime⟩).2.ne.symm,
  suffices : d = (gcd a b), { rwa ←this },
  apply gcd_greatest,
  { rw [←factorization_le_iff_dvd hd_pos ha_pos, h1], exact inf_le_left },
  { rw [←factorization_le_iff_dvd hd_pos hb_pos, h1], exact inf_le_right },
  { intros e hea heb,
    rcases decidable.eq_or_ne e 0 with rfl | he_pos,
    { simp only [zero_dvd_iff] at hea, contradiction, },
    have hea' := (factorization_le_iff_dvd he_pos ha_pos).mpr hea,
    have heb' := (factorization_le_iff_dvd he_pos hb_pos).mpr heb,
    simp [←factorization_le_iff_dvd he_pos hd_pos, h1, hea', heb'] },
end

/-! ### Factorization and coprimes -/

/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
lemma factorization_mul_apply_of_coprime {p a b : ℕ} (hab : coprime a b)  :
  (a * b).factorization p = a.factorization p + b.factorization p :=
by simp only [←factors_count_eq, perm_iff_count.mp (perm_factors_mul_of_coprime hab), count_append]

/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
lemma factorization_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization = a.factorization + b.factorization :=
begin
  ext q,
  simp only [finsupp.coe_add, add_apply, ←factors_count_eq, factorization_mul_apply_of_coprime hab],
end

/-- If `p` is a prime factor of `a` then the power of `p` in `a` is the same that in `a * b`,
for any `b` coprime to `a`. -/
lemma factorization_eq_of_coprime_left {p a b : ℕ} (hab : coprime a b) (hpa : p ∈ a.factors) :
  (a * b).factorization p = a.factorization p :=
begin
  rw [factorization_mul_apply_of_coprime hab, ←factors_count_eq, ←factors_count_eq],
  simpa only [count_eq_zero_of_not_mem (coprime_factors_disjoint hab hpa)],
end

/-- If `p` is a prime factor of `b` then the power of `p` in `b` is the same that in `a * b`,
for any `a` coprime to `b`. -/
lemma factorization_eq_of_coprime_right {p a b : ℕ} (hab : coprime a b) (hpb : p ∈ b.factors) :
  (a * b).factorization p = b.factorization p :=
by { rw mul_comm, exact factorization_eq_of_coprime_left (coprime_comm.mp hab) hpb }

/-- The prime factorizations of coprime `a` and `b` are disjoint -/
lemma factorization_disjoint_of_coprime {a b : ℕ} (hab : coprime a b) :
  disjoint a.factorization.support b.factorization.support :=
by simpa only [support_factorization]
  using disjoint_to_finset_iff_disjoint.mpr (coprime_factors_disjoint hab)

/-- For coprime `a` and `b` the prime factorization `a * b` is the union of those of `a` and `b` -/
lemma factorization_mul_support_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  rw factorization_mul_of_coprime hab,
  exact support_add_eq (factorization_disjoint_of_coprime hab),
end

/-! ### Induction principles involving factorizations -/

/-- Given `P 0, P 1` and a way to extend `P a` to `P (p ^ n * a)` for prime `p` not dividing `a`,
we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_prime_pow {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1)
  (h : ∀ a p n : ℕ, p.prime → ¬ p ∣ a → 0 < n → P a → P (p ^ n * a)) : ∀ (a : ℕ), P a :=
λ a, nat.strong_rec_on a $ λ n,
  match n with
  | 0     := λ _, h0
  | 1     := λ _, h1
  | (k+2) := λ hk, begin
    let p := (k + 2).min_fac,
    have hp : prime p := min_fac_prime (succ_succ_ne_one k),
    -- the awkward `let` stuff here is because `factorization` is noncomputable (finsupp);
    -- we get around this by using the computable `factors.count`, and rewriting when we want
    -- to use the `factorization` API
    let t := (k+2).factors.count p,
    have ht : t = (k+2).factorization p := factors_count_eq,
    have hpt : p ^ t ∣ k + 2 := by { rw ht, exact pow_factorization_dvd _ _ },
    have htp : 0 < t :=
    by { rw ht, exact hp.factorization_pos_of_dvd (nat.succ_ne_zero _) (min_fac_dvd _) },
    convert h ((k + 2) / p ^ t) p t hp _ _ _,
    { rw nat.mul_div_cancel' hpt, },
    { rw [nat.dvd_div_iff hpt, ←pow_succ', ht],
      exact pow_succ_factorization_not_dvd (k + 1).succ_ne_zero hp },
    { exact htp },
    { apply hk _ (nat.div_lt_of_lt_mul _),
      simp [lt_mul_iff_one_lt_left nat.succ_pos', one_lt_pow_iff htp.ne, hp.one_lt] },
    end
  end

/-- Given `P 0`, `P 1`, and `P (p ^ n)` for positive prime powers, and a way to extend `P a` and
`P b` to `P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_pos_prime_pos_coprime {P : ℕ → Sort*} (hp : ∀ p n : ℕ, prime p → 0 < n → P (p ^ n))
  (h0 : P 0) (h1 : P 1) (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) :
  ∀ a, P a :=
rec_on_prime_pow h0 h1 $
begin
  intros a p n hp' hpa hn hPa,
  by_cases ha1 : a = 1,
  { rw [ha1, mul_one],
    exact hp p n hp' hn },
  refine h (p^n) a ((hp'.one_lt).trans_le (le_self_pow (prime.one_lt hp').le (succ_le_iff.mpr hn)))
    _ _ (hp _ _ hp' hn) hPa,
  { refine lt_of_not_ge (λ (h : a ≤ 1), _),
    interval_cases a,
    { simpa only [dvd_zero, not_true] using hpa },
    { contradiction } },
  simpa [hn, prime.coprime_iff_not_dvd hp'],
end

/-- Given `P 0`, `P (p ^ n)` for all prime powers, and a way to extend `P a` and `P b` to
`P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_prime_coprime {P : ℕ → Sort*} (h0 : P 0) (hp : ∀ p n : ℕ, prime p → P (p ^ n))
  (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : ∀ a, P a :=
rec_on_pos_prime_pos_coprime (λ p n h _, hp p n h) h0 (hp 2 0 prime_two) h

/-- Given `P 0`, `P 1`, `P p` for all primes, and a way to extend `P a` and `P b` to
`P (a * b)`, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_mul {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1)
  (hp : ∀ p, prime p → P p) (h : ∀ a b, P a → P b → P (a * b)) : ∀ a, P a :=
let hp : ∀ p n : ℕ, prime p → P (p ^ n) :=
  λ p n hp', match n with
  | 0     := h1
  | (n+1) := by exact h _ _ (hp p hp') (_match _)
  end in
rec_on_prime_coprime h0 hp $ λ a b _ _ _, h a b

/-- For any multiplicative function `f` with `f 1 = 1` and any `n ≠ 0`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf : f 1 = 1) :
  ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_pos_coprime,
  { intros p k hp hk hpk, simp [prime.factorization_pow hp, finsupp.prod_single_index _, hf] },
  { simp },
  { rintros -, rw [factorization_one, hf], simp },
  { intros a b _ _ hab ha hb hab_pos,
    rw [h_mult a b hab, ha (left_ne_zero_of_mul hab_pos), hb (right_ne_zero_of_mul hab_pos),
        factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

/-- For any multiplicative function `f` with `f 1 = 1` and `f 0 = 1`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization' {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf0 : f 0 = 1) (hf1 : f 1 = 1) :
  ∀ {n : ℕ}, f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_pos_coprime,
  { intros p k hp hk, simp only [hp.factorization_pow], rw prod_single_index _, simp [hf1] },
  { simp [hf0] },
  { rw [factorization_one, hf1], simp },
  { intros a b _ _ hab ha hb,
    rw [h_mult a b hab, ha, hb, factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

end nat


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u

namespace Mathlib

namespace nat

notation:1024 "ℕ" => Mathlib.nat

inductive less_than_or_equal (a : ℕ) : ℕ → Prop where
| refl : less_than_or_equal a a
| step : ∀ {b : ℕ}, less_than_or_equal a b → less_than_or_equal a (Nat.succ b)

protected instance has_le : HasLessEq ℕ := { LessEq := less_than_or_equal }

protected def le (n : ℕ) (m : ℕ) := less_than_or_equal n m

protected def lt (n : ℕ) (m : ℕ) := less_than_or_equal (Nat.succ n) m

protected instance has_lt : HasLess ℕ := { Less := nat.lt }

def pred : ℕ → ℕ := Nat.pred

protected def sub : ℕ → ℕ → ℕ := Nat.sub

protected def mul : ℕ → ℕ → ℕ := Nat.mul

protected instance has_sub : Sub ℕ := { sub := Nat.sub }

protected instance has_mul : Mul ℕ := { mul := Nat.mul }

-- defeq to the instance provided by comm_semiring

protected instance has_dvd : has_dvd ℕ := has_dvd.mk fun (a b : ℕ) => ∃ (c : ℕ), b = a * c

protected instance decidable_eq : DecidableEq ℕ := sorry

def repeat {α : Type u} (f : ℕ → α → α) : ℕ → α → α := sorry

protected instance inhabited : Inhabited ℕ := { default := 0 }

@[simp] theorem nat_zero_eq_zero : 0 = 0 := rfl

/- properties of inequality -/

protected def le_refl (a : ℕ) : a ≤ a := less_than_or_equal.refl

theorem le_succ (n : ℕ) : n ≤ Nat.succ n := less_than_or_equal.step (nat.le_refl n)

theorem succ_le_succ {n : ℕ} {m : ℕ} : n ≤ m → Nat.succ n ≤ Nat.succ m :=
  fun (h : n ≤ m) =>
    less_than_or_equal._oldrec (nat.le_refl (Nat.succ n))
      (fun (a : ℕ) (b : less_than_or_equal n a) => less_than_or_equal.step) h

theorem zero_le (n : ℕ) : 0 ≤ n := sorry

theorem zero_lt_succ (n : ℕ) : 0 < Nat.succ n := succ_le_succ (zero_le n)

def succ_pos (n : ℕ) : 0 < Nat.succ n := zero_lt_succ

theorem not_succ_le_zero (n : ℕ) : Nat.succ n ≤ 0 → False := sorry

theorem not_lt_zero (a : ℕ) : ¬a < 0 := not_succ_le_zero a

theorem pred_le_pred {n : ℕ} {m : ℕ} : n ≤ m → Nat.pred n ≤ Nat.pred m := sorry

theorem le_of_succ_le_succ {n : ℕ} {m : ℕ} : Nat.succ n ≤ Nat.succ m → n ≤ m := pred_le_pred

protected instance decidable_le (a : ℕ) (b : ℕ) : Decidable (a ≤ b) := sorry

protected instance decidable_lt (a : ℕ) (b : ℕ) : Decidable (a < b) :=
  nat.decidable_le (Nat.succ a) b

protected theorem eq_or_lt_of_le {a : ℕ} {b : ℕ} (h : a ≤ b) : a = b ∨ a < b :=
  less_than_or_equal.cases_on h (Or.inl rfl)
    fun (n : ℕ) (h : less_than_or_equal a n) => Or.inr (succ_le_succ h)

theorem lt_succ_of_le {a : ℕ} {b : ℕ} : a ≤ b → a < Nat.succ b := succ_le_succ

@[simp] theorem succ_sub_succ_eq_sub (a : ℕ) (b : ℕ) : Nat.succ a - Nat.succ b = a - b :=
  nat.rec_on b ((fun (this : Nat.succ a - 1 = a - 0) => this) (Eq.refl (Nat.succ a - 1)))
    fun (b : ℕ) => congr_arg Nat.pred

theorem not_succ_le_self (n : ℕ) : ¬Nat.succ n ≤ n :=
  Nat.rec (not_succ_le_zero 0)
    (fun (a : ℕ) (b : ¬Nat.succ a ≤ a) (c : Nat.succ (Nat.succ a) ≤ Nat.succ a) =>
      b (le_of_succ_le_succ c))
    n

protected theorem lt_irrefl (n : ℕ) : ¬n < n := not_succ_le_self n

protected theorem le_trans {n : ℕ} {m : ℕ} {k : ℕ} (h1 : n ≤ m) : m ≤ k → n ≤ k :=
  less_than_or_equal._oldrec h1 fun (p : ℕ) (h2 : less_than_or_equal m p) => less_than_or_equal.step

theorem pred_le (n : ℕ) : Nat.pred n ≤ n :=
  nat.cases_on n (idRhs (less_than_or_equal (Nat.pred 0) (Nat.pred 0)) less_than_or_equal.refl)
    fun (n : ℕ) =>
      idRhs (less_than_or_equal (Nat.pred (Nat.succ n)) (Nat.succ n))
        (less_than_or_equal.step less_than_or_equal.refl)

theorem pred_lt {n : ℕ} : n ≠ 0 → Nat.pred n < n := sorry

theorem sub_le (a : ℕ) (b : ℕ) : a - b ≤ a :=
  nat.rec_on b (nat.le_refl (a - 0)) fun (b₁ : ℕ) => nat.le_trans (pred_le (a - b₁))

theorem sub_lt {a : ℕ} {b : ℕ} : 0 < a → 0 < b → a - b < a := sorry

protected theorem lt_of_lt_of_le {n : ℕ} {m : ℕ} {k : ℕ} : n < m → m ≤ k → n < k := nat.le_trans

/- Basic nat.add lemmas -/

protected theorem zero_add (n : ℕ) : 0 + n = n := sorry

theorem succ_add (n : ℕ) (m : ℕ) : Nat.succ n + m = Nat.succ (n + m) := sorry

theorem add_succ (n : ℕ) (m : ℕ) : n + Nat.succ m = Nat.succ (n + m) := rfl

protected theorem add_zero (n : ℕ) : n + 0 = n := rfl

theorem add_one (n : ℕ) : n + 1 = Nat.succ n := rfl

theorem succ_eq_add_one (n : ℕ) : Nat.succ n = n + 1 := rfl

/- Basic lemmas for comparing numerals -/

protected theorem bit0_succ_eq (n : ℕ) : bit0 (Nat.succ n) = Nat.succ (Nat.succ (bit0 n)) :=
  (fun (this : Nat.succ (Nat.succ n + n) = Nat.succ (Nat.succ (n + n))) => this)
    (congr_arg Nat.succ (succ_add n n))

protected theorem zero_lt_bit0 {n : ℕ} : n ≠ 0 → 0 < bit0 n := sorry

protected theorem zero_lt_bit1 (n : ℕ) : 0 < bit1 n := zero_lt_succ (bit0 n)

protected theorem bit0_ne_zero {n : ℕ} : n ≠ 0 → bit0 n ≠ 0 := sorry

protected theorem bit1_ne_zero (n : ℕ) : bit1 n ≠ 0 :=
  (fun (this : Nat.succ (n + n) ≠ 0) => this) fun (h : Nat.succ (n + n) = 0) => nat.no_confusion h

end Mathlib


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

import data.finite.card
import group_theory.finiteness
import group_theory.group_action.quotient

/-!
# Index of a Subgroup

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

In this file we define the index of a subgroup, and prove several divisibility properties.
Several theorems proved in this file are known as Lagrange's theorem.

## Main definitions

- `H.index` : the index of `H : subgroup G` as a natural number,
  and returns 0 if the index is infinite.
- `H.relindex K` : the relative index of `H : subgroup G` in `K : subgroup G` as a natural number,
  and returns 0 if the relative index is infinite.

# Main results

- `card_mul_index` : `nat.card H * H.index = nat.card G`
- `index_mul_card` : `H.index * fintype.card H = fintype.card G`
- `index_dvd_card` : `H.index ∣ fintype.card G`
- `index_eq_mul_of_le` : If `H ≤ K`, then `H.index = K.index * (H.subgroup_of K).index`
- `index_dvd_of_le` : If `H ≤ K`, then `K.index ∣ H.index`
- `relindex_mul_relindex` : `relindex` is multiplicative in towers

-/

namespace subgroup

open_locale big_operators cardinal

variables {G : Type*} [group G] (H K L : subgroup G)

/-- The index of a subgroup as a natural number, and returns 0 if the index is infinite. -/
@[to_additive "The index of a subgroup as a natural number,
and returns 0 if the index is infinite."]
noncomputable def index : ℕ :=
nat.card (G ⧸ H)

/-- The relative index of a subgroup as a natural number,
  and returns 0 if the relative index is infinite. -/
@[to_additive "The relative index of a subgroup as a natural number,
  and returns 0 if the relative index is infinite."]
noncomputable def relindex : ℕ :=
(H.subgroup_of K).index

@[to_additive] lemma index_comap_of_surjective {G' : Type*} [group G'] {f : G' →* G}
  (hf : function.surjective f) : (H.comap f).index = H.index :=
begin
  letI := quotient_group.left_rel H,
  letI := quotient_group.left_rel (H.comap f),
  have key : ∀ x y : G', setoid.r x y ↔ setoid.r (f x) (f y),
  { simp only [quotient_group.left_rel_apply],
    exact λ x y, iff_of_eq (congr_arg (∈ H) (by rw [f.map_mul, f.map_inv])) },
  refine cardinal.to_nat_congr (equiv.of_bijective (quotient.map' f (λ x y, (key x y).mp)) ⟨_, _⟩),
  { simp_rw [←quotient.eq'] at key,
    refine quotient.ind' (λ x, _),
    refine quotient.ind' (λ y, _),
    exact (key x y).mpr },
  { refine quotient.ind' (λ x, _),
    obtain ⟨y, hy⟩ := hf x,
    exact ⟨y, (quotient.map'_mk' f _ y).trans (congr_arg quotient.mk' hy)⟩ },
end

@[to_additive] lemma index_comap {G' : Type*} [group G'] (f : G' →* G) :
  (H.comap f).index = H.relindex f.range :=
eq.trans (congr_arg index (by refl))
  ((H.subgroup_of f.range).index_comap_of_surjective f.range_restrict_surjective)

@[to_additive] lemma relindex_comap {G' : Type*} [group G'] (f : G' →* G) (K : subgroup G') :
  relindex (comap f H) K = relindex H (map f K) :=
by rw [relindex, subgroup_of, comap_comap, index_comap, ← f.map_range, K.subtype_range]

variables {H K L}

@[to_additive relindex_mul_index] lemma relindex_mul_index (h : H ≤ K) :
  H.relindex K * K.index = H.index :=
((mul_comm _ _).trans (cardinal.to_nat_mul _ _).symm).trans
  (congr_arg cardinal.to_nat (equiv.cardinal_eq (quotient_equiv_prod_of_le h))).symm

@[to_additive] lemma index_dvd_of_le (h : H ≤ K) : K.index ∣ H.index :=
dvd_of_mul_left_eq (H.relindex K) (relindex_mul_index h)

@[to_additive] lemma relindex_dvd_index_of_le (h : H ≤ K) : H.relindex K ∣ H.index :=
dvd_of_mul_right_eq K.index (relindex_mul_index h)

@[to_additive] lemma relindex_subgroup_of (hKL : K ≤ L) :
  (H.subgroup_of L).relindex (K.subgroup_of L) = H.relindex K :=
((index_comap (H.subgroup_of L) (inclusion hKL)).trans (congr_arg _ (inclusion_range hKL))).symm

variables (H K L)

@[to_additive relindex_mul_relindex] lemma relindex_mul_relindex (hHK : H ≤ K) (hKL : K ≤ L) :
  H.relindex K * K.relindex L = H.relindex L :=
begin
  rw [←relindex_subgroup_of hKL],
  exact relindex_mul_index (λ x hx, hHK hx),
end

@[to_additive] lemma inf_relindex_right : (H ⊓ K).relindex K = H.relindex K :=
by rw [relindex, relindex, inf_subgroup_of_right]

@[to_additive] lemma inf_relindex_left : (H ⊓ K).relindex H = K.relindex H :=
by rw [inf_comm, inf_relindex_right]

@[to_additive relindex_inf_mul_relindex]
lemma relindex_inf_mul_relindex : H.relindex (K ⊓ L) * K.relindex L = (H ⊓ K).relindex L :=
by rw [←inf_relindex_right H (K ⊓ L), ←inf_relindex_right K L, ←inf_relindex_right (H ⊓ K) L,
  inf_assoc, relindex_mul_relindex (H ⊓ (K ⊓ L)) (K ⊓ L) L inf_le_right inf_le_right]

@[simp, to_additive]
lemma relindex_sup_right [K.normal] : K.relindex (H ⊔ K) = K.relindex H  :=
nat.card_congr (quotient_group.quotient_inf_equiv_prod_normal_quotient H K).to_equiv.symm

@[simp, to_additive]
lemma relindex_sup_left [K.normal] : K.relindex (K ⊔ H) = K.relindex H  :=
by rw [sup_comm, relindex_sup_right]

@[to_additive] lemma relindex_dvd_index_of_normal [H.normal] : H.relindex K ∣ H.index :=
relindex_sup_right K H ▸ relindex_dvd_index_of_le le_sup_right

variables {H K}

@[to_additive] lemma relindex_dvd_of_le_left (hHK : H ≤ K) : K.relindex L ∣ H.relindex L :=
inf_of_le_left hHK ▸ dvd_of_mul_left_eq _ (relindex_inf_mul_relindex _ _ _)

/-- A subgroup has index two if and only if there exists `a` such that for all `b`, exactly one
of `b * a` and `b` belong to `H`. -/
@[to_additive "/-- An additive subgroup has index two if and only if there exists `a` such that for
all `b`, exactly one of `b + a` and `b` belong to `H`. -/"]
lemma index_eq_two_iff : H.index = 2 ↔ ∃ a, ∀ b, xor (b * a ∈ H) (b ∈ H) :=
begin
  simp only [index, nat.card_eq_two_iff' ((1 : G) : G ⧸ H), exists_unique, inv_mem_iff,
    quotient_group.exists_coe, quotient_group.forall_coe, ne.def, quotient_group.eq, mul_one,
    xor_iff_iff_not],
  refine exists_congr (λ a, ⟨λ ha b, ⟨λ hba hb, _, λ hb, _⟩, λ ha, ⟨_, λ b hb, _⟩⟩),
  { exact ha.1 ((mul_mem_cancel_left hb).1 hba) },
  { exact inv_inv b ▸ ha.2 _ (mt inv_mem_iff.1 hb) },
  { rw [← inv_mem_iff, ← ha, inv_mul_self], exact one_mem _ },
  { rwa [ha, inv_mem_iff] }
end

@[to_additive] lemma mul_mem_iff_of_index_two (h : H.index = 2) {a b : G} :
  a * b ∈ H ↔ (a ∈ H ↔ b ∈ H) :=
begin
  by_cases ha : a ∈ H, { simp only [ha, true_iff, mul_mem_cancel_left ha] },
  by_cases hb : b ∈ H, { simp only [hb, iff_true, mul_mem_cancel_right hb] },
  simp only [ha, hb, iff_self, iff_true],
  rcases index_eq_two_iff.1 h with ⟨c, hc⟩,
  refine (hc _).or.resolve_left _,
  rwa [mul_assoc, mul_mem_cancel_right ((hc _).or.resolve_right hb)]
end

@[to_additive] lemma mul_self_mem_of_index_two (h : H.index = 2) (a : G) : a * a ∈ H :=
by rw [mul_mem_iff_of_index_two h]

@[to_additive two_smul_mem_of_index_two]
lemma sq_mem_of_index_two (h : H.index = 2) (a : G) : a ^ 2 ∈ H :=
(pow_two a).symm ▸ mul_self_mem_of_index_two h a

variables (H K)

@[simp, to_additive] lemma index_top : (⊤ : subgroup G).index = 1 :=
cardinal.to_nat_eq_one_iff_unique.mpr ⟨quotient_group.subsingleton_quotient_top, ⟨1⟩⟩

@[simp, to_additive] lemma index_bot : (⊥ : subgroup G).index = nat.card G :=
cardinal.to_nat_congr (quotient_group.quotient_bot.to_equiv)

@[to_additive] lemma index_bot_eq_card [fintype G] : (⊥ : subgroup G).index = fintype.card G :=
index_bot.trans nat.card_eq_fintype_card

@[simp, to_additive] lemma relindex_top_left : (⊤ : subgroup G).relindex H = 1 :=
index_top

@[simp, to_additive] lemma relindex_top_right : H.relindex ⊤ = H.index :=
by rw [←relindex_mul_index (show H ≤ ⊤, from le_top), index_top, mul_one]

@[simp, to_additive] lemma relindex_bot_left : (⊥ : subgroup G).relindex H = nat.card H :=
by rw [relindex, bot_subgroup_of, index_bot]

@[to_additive] lemma relindex_bot_left_eq_card [fintype H] :
  (⊥ : subgroup G).relindex H = fintype.card H :=
H.relindex_bot_left.trans nat.card_eq_fintype_card

@[simp, to_additive] lemma relindex_bot_right : H.relindex ⊥ = 1 :=
by rw [relindex, subgroup_of_bot_eq_top, index_top]

@[simp, to_additive] lemma relindex_self : H.relindex H = 1 :=
by rw [relindex, subgroup_of_self, index_top]

@[to_additive] lemma index_ker {H} [group H] (f : G →* H) :
  f.ker.index = nat.card (set.range f) :=
by { rw [← monoid_hom.comap_bot, index_comap, relindex_bot_left], refl }

@[to_additive] lemma relindex_ker {H} [group H] (f : G →* H) (K : subgroup G) :
  f.ker.relindex K = nat.card (f '' K) :=
by { rw [← monoid_hom.comap_bot, relindex_comap, relindex_bot_left], refl }

@[simp, to_additive card_mul_index]
lemma card_mul_index : nat.card H * H.index = nat.card G :=
by { rw [←relindex_bot_left, ←index_bot], exact relindex_mul_index bot_le }

@[to_additive] lemma nat_card_dvd_of_injective {G H : Type*} [group G] [group H] (f : G →* H)
  (hf : function.injective f) : nat.card G ∣ nat.card H :=
begin
  rw nat.card_congr (monoid_hom.of_injective hf).to_equiv,
  exact dvd.intro f.range.index f.range.card_mul_index,
end

@[to_additive] lemma nat_card_dvd_of_le (hHK : H ≤ K) : nat.card H ∣ nat.card K :=
nat_card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)

@[to_additive] lemma nat_card_dvd_of_surjective {G H : Type*} [group G] [group H] (f : G →* H)
  (hf : function.surjective f) : nat.card H ∣ nat.card G :=
begin
  rw ← nat.card_congr (quotient_group.quotient_ker_equiv_of_surjective f hf).to_equiv,
  exact dvd.intro_left (nat.card f.ker) f.ker.card_mul_index,
end

@[to_additive] lemma card_dvd_of_surjective {G H : Type*} [group G] [group H] [fintype G]
  [fintype H] (f : G →* H) (hf : function.surjective f) : fintype.card H ∣ fintype.card G :=
by simp only [←nat.card_eq_fintype_card, nat_card_dvd_of_surjective f hf]

@[to_additive] lemma index_map {G' : Type*} [group G'] (f : G →* G') :
  (H.map f).index = (H ⊔ f.ker).index * f.range.index :=
by rw [←comap_map_eq, index_comap, relindex_mul_index (H.map_le_range f)]

@[to_additive] lemma index_map_dvd {G' : Type*} [group G'] {f : G →* G'}
  (hf : function.surjective f) : (H.map f).index ∣ H.index :=
begin
  rw [index_map, f.range_top_of_surjective hf, index_top, mul_one],
  exact index_dvd_of_le le_sup_left,
end

@[to_additive] lemma dvd_index_map {G' : Type*} [group G'] {f : G →* G'}
  (hf : f.ker ≤ H) : H.index ∣ (H.map f).index :=
begin
  rw [index_map, sup_of_le_left hf],
  apply dvd_mul_right,
end

@[to_additive] lemma index_map_eq {G' : Type*} [group G'] {f : G →* G'}
  (hf1 : function.surjective f) (hf2 : f.ker ≤ H) : (H.map f).index = H.index :=
nat.dvd_antisymm (H.index_map_dvd hf1) (H.dvd_index_map hf2)

@[to_additive] lemma index_eq_card [fintype (G ⧸ H)] :
  H.index = fintype.card (G ⧸ H) :=
nat.card_eq_fintype_card

@[to_additive index_mul_card] lemma index_mul_card [fintype G] [hH : fintype H] :
  H.index * fintype.card H = fintype.card G :=
by rw [←relindex_bot_left_eq_card, ←index_bot_eq_card, mul_comm]; exact relindex_mul_index bot_le

@[to_additive] lemma index_dvd_card [fintype G] : H.index ∣ fintype.card G :=
begin
  classical,
  exact ⟨fintype.card H, H.index_mul_card.symm⟩,
end

variables {H K L}

@[to_additive]
lemma relindex_eq_zero_of_le_left (hHK : H ≤ K) (hKL : K.relindex L = 0) : H.relindex L = 0 :=
eq_zero_of_zero_dvd (hKL ▸ (relindex_dvd_of_le_left L hHK))

@[to_additive]
lemma relindex_eq_zero_of_le_right (hKL : K ≤ L) (hHK : H.relindex K = 0) : H.relindex L = 0 :=
finite.card_eq_zero_of_embedding (quotient_subgroup_of_embedding_of_le H hKL) hHK

@[to_additive]

@[to_additive] lemma relindex_le_of_le_left (hHK : H ≤ K) (hHL : H.relindex L ≠ 0) :
  K.relindex L ≤ H.relindex L :=
nat.le_of_dvd (nat.pos_of_ne_zero hHL) (relindex_dvd_of_le_left L hHK)

@[to_additive] lemma relindex_le_of_le_right (hKL : K ≤ L) (hHL : H.relindex L ≠ 0) :
  H.relindex K ≤ H.relindex L :=
finite.card_le_of_embedding' (quotient_subgroup_of_embedding_of_le H hKL) (λ h, (hHL h).elim)

@[to_additive] lemma relindex_ne_zero_trans (hHK : H.relindex K ≠ 0) (hKL : K.relindex L ≠ 0) :
  H.relindex L ≠ 0 :=
λ h, mul_ne_zero (mt (relindex_eq_zero_of_le_right (show K ⊓ L ≤ K, from inf_le_left)) hHK) hKL
  ((relindex_inf_mul_relindex H K L).trans (relindex_eq_zero_of_le_left inf_le_left h))

@[to_additive] lemma relindex_inf_ne_zero (hH : H.relindex L ≠ 0) (hK : K.relindex L ≠ 0) :
  (H ⊓ K).relindex L ≠ 0 :=
begin
  replace hH : H.relindex (K ⊓ L) ≠ 0 := mt (relindex_eq_zero_of_le_right inf_le_right) hH,
  rw ← inf_relindex_right at hH hK ⊢,
  rw inf_assoc,
  exact relindex_ne_zero_trans hH hK,
end

@[to_additive] lemma index_inf_ne_zero (hH : H.index ≠ 0) (hK : K.index ≠ 0) : (H ⊓ K).index ≠ 0 :=
begin
  rw ← relindex_top_right at hH hK ⊢,
  exact relindex_inf_ne_zero hH hK,
end

@[to_additive] lemma relindex_inf_le : (H ⊓ K).relindex L ≤ H.relindex L * K.relindex L :=
begin
  by_cases h : H.relindex L = 0,
  { exact (le_of_eq (relindex_eq_zero_of_le_left (by exact inf_le_left) h)).trans (zero_le _) },
  rw [←inf_relindex_right, inf_assoc, ←relindex_mul_relindex _ _ L inf_le_right inf_le_right,
      inf_relindex_right, inf_relindex_right],
  exact mul_le_mul_right' (relindex_le_of_le_right inf_le_right h) (K.relindex L),
end

@[to_additive] lemma index_inf_le : (H ⊓ K).index ≤ H.index * K.index :=
by simp_rw [←relindex_top_right, relindex_inf_le]

@[to_additive] lemma relindex_infi_ne_zero {ι : Type*} [hι : finite ι] {f : ι → subgroup G}
  (hf : ∀ i, (f i).relindex L ≠ 0) : (⨅ i, f i).relindex L ≠ 0 :=
begin
  haveI := fintype.of_finite ι,
  exact finset.prod_ne_zero_iff.mpr (λ i hi, hf i) ∘ nat.card_pi.symm.trans ∘
    finite.card_eq_zero_of_embedding (quotient_infi_subgroup_of_embedding f L),
end

@[to_additive] lemma relindex_infi_le {ι : Type*} [fintype ι] (f : ι → subgroup G) :
  (⨅ i, f i).relindex L ≤ ∏ i, (f i).relindex L :=
le_of_le_of_eq (finite.card_le_of_embedding' (quotient_infi_subgroup_of_embedding f L)
  (λ h, let ⟨i, hi, h⟩ := finset.prod_eq_zero_iff.mp (nat.card_pi.symm.trans h) in
    relindex_eq_zero_of_le_left (infi_le f i) h)) nat.card_pi

@[to_additive] lemma index_infi_ne_zero {ι : Type*} [finite ι] {f : ι → subgroup G}
  (hf : ∀ i, (f i).index ≠ 0) : (⨅ i, f i).index ≠ 0 :=
begin
  simp_rw ← relindex_top_right at hf ⊢,
  exact relindex_infi_ne_zero hf,
end

@[to_additive] lemma index_infi_le {ι : Type*} [fintype ι] (f : ι → subgroup G) :
  (⨅ i, f i).index ≤ ∏ i, (f i).index :=
by simp_rw [←relindex_top_right, relindex_infi_le]

@[simp, to_additive index_eq_one] lemma index_eq_one : H.index = 1 ↔ H = ⊤ :=
⟨λ h, quotient_group.subgroup_eq_top_of_subsingleton H (cardinal.to_nat_eq_one_iff_unique.mp h).1,
  λ h, (congr_arg index h).trans index_top⟩

@[simp, to_additive relindex_eq_one] lemma relindex_eq_one : H.relindex K = 1 ↔ K ≤ H :=
index_eq_one.trans subgroup_of_eq_top

@[simp, to_additive card_eq_one] lemma card_eq_one : nat.card H = 1 ↔ H = ⊥ :=
H.relindex_bot_left ▸ (relindex_eq_one.trans le_bot_iff)

@[to_additive] lemma index_ne_zero_of_finite [hH : finite (G ⧸ H)] : H.index ≠ 0 :=
by { casesI nonempty_fintype (G ⧸ H), rw index_eq_card, exact fintype.card_ne_zero }

/-- Finite index implies finite quotient. -/
@[to_additive "Finite index implies finite quotient."]
noncomputable def fintype_of_index_ne_zero (hH : H.index ≠ 0) : fintype (G ⧸ H) :=
(cardinal.lt_aleph_0_iff_fintype.mp (lt_of_not_ge (mt cardinal.to_nat_apply_of_aleph_0_le hH))).some

@[to_additive one_lt_index_of_ne_top]
lemma one_lt_index_of_ne_top [finite (G ⧸ H)] (hH : H ≠ ⊤) : 1 < H.index :=
nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨index_ne_zero_of_finite, mt index_eq_one.mp hH⟩

section finite_index

variables (H K)

/-- Typeclass for finite index subgroups. -/
class finite_index : Prop :=
(finite_index : H.index ≠ 0)

/-- Typeclass for finite index subgroups. -/
class _root_.add_subgroup.finite_index {G : Type*} [add_group G] (H : add_subgroup G) : Prop :=
(finite_index : H.index ≠ 0)

/-- A finite index subgroup has finite quotient. -/
@[to_additive "A finite index subgroup has finite quotient"]
noncomputable def fintype_quotient_of_finite_index [finite_index H] :
  fintype (G ⧸ H) :=
fintype_of_index_ne_zero finite_index.finite_index

@[to_additive] instance finite_quotient_of_finite_index
  [finite_index H] : finite (G ⧸ H) :=
H.fintype_quotient_of_finite_index.finite

@[to_additive] lemma finite_index_of_finite_quotient [finite (G ⧸ H)] : finite_index H :=
⟨index_ne_zero_of_finite⟩

@[priority 100, to_additive] instance finite_index_of_finite [finite G] : finite_index H :=
finite_index_of_finite_quotient H

@[to_additive] instance : finite_index (⊤ : subgroup G) :=
⟨ne_of_eq_of_ne index_top one_ne_zero⟩

@[to_additive] instance [finite_index H] [finite_index K] : finite_index (H ⊓ K) :=
⟨index_inf_ne_zero finite_index.finite_index finite_index.finite_index⟩

variables {H K}

@[to_additive] lemma finite_index_of_le [finite_index H] (h : H ≤ K) : finite_index K :=
⟨ne_zero_of_dvd_ne_zero finite_index.finite_index (index_dvd_of_le h)⟩

variables (H K)

@[to_additive] instance finite_index_ker {G' : Type*} [group G'] (f : G →* G') [finite f.range] :
  f.ker.finite_index :=
@finite_index_of_finite_quotient G _ f.ker
  (finite.of_equiv f.range (quotient_group.quotient_ker_equiv_range f).symm)

instance finite_index_normal_core [H.finite_index] : H.normal_core.finite_index :=
begin
  rw normal_core_eq_ker,
  apply_instance,
end

variables (G)

instance finite_index_center [finite (commutator_set G)] [group.fg G] : finite_index (center G) :=
begin
  obtain ⟨S, -, hS⟩ := group.rank_spec G,
  exact ⟨mt (finite.card_eq_zero_of_embedding (quotient_center_embedding hS)) finite.card_pos.ne'⟩,
end

lemma index_center_le_pow [finite (commutator_set G)] [group.fg G] :
  (center G).index ≤ (nat.card (commutator_set G)) ^ group.rank G :=
begin
  obtain ⟨S, hS1, hS2⟩ := group.rank_spec G,
  rw [←hS1, ←fintype.card_coe, ←nat.card_eq_fintype_card, ←finset.coe_sort_coe, ←nat.card_fun],
  exact finite.card_le_of_embedding (quotient_center_embedding hS2),
end

end finite_index

end subgroup


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

import tactic

/-

# Bijections

Like finiteness, there are two ways to say that a function is bijective in Lean.
Furthermore, you will have heard of both of them, although it may well not
have occurred to you that these two ways were particularly different. It turns
out that one of them is more constructive than the other. Let's talk about
the nonconstructive (propositional) way of talking about bijections.

Let `X` and `Y` be types, and say `f : X → Y` is a function.

-/

variables (X Y : Type) (f : X → Y)

-- The `Prop`-valued way of saying that `f` is bijective is simply
-- to say literally that `f` is bijective, i.e., injective and surjective.

example : Prop := function.bijective f

-- Because `f` is a function type, a little Lean hack introduced recently
-- actually enables you to use dot notation for this.

example : Prop := f.bijective

-- The definition of `function.bijective f` is
-- `function.injective f ∧ function.surjective f`, and the definitions of
-- injective and surjective are what you think they are.

example : f.bijective ↔ f.injective ∧ f.surjective :=
begin
  refl
end

example : f.bijective ↔ (∀ x₁ x₂ : X, f x₁ = f x₂ → x₁ = x₂) ∧
  (∀ y : Y, ∃ x : X, f x = y) :=
begin
  refl
end

-- It's a theorem that `f` is bijective if and only if it has a two-sided
-- inverse. One way is not hard to prove: see if you can do it. Make
-- sure you know the maths proof first! If you can't do this then
-- please ask. There's lots of little Lean tricks which make this
-- question not too bad, but there are lots of little pitfalls too.

example : (∃ g : Y → X, f ∘ g = id ∧ g ∘ f = id) → f.bijective :=
begin
  rintro ⟨g, hfg, hgf⟩,
  split,
  { -- injectivity
    intros a b h,
    -- want to get from `g ∘ f = id` to `∀ x, g (f x) = x`.
    -- Use `simp_rw` to rewrite under the binder.
    simp_rw [function.funext_iff, function.comp_apply] at hgf,
    -- `apply_fun` can change a hypothesis `x = y` to `g x = g y`.
    apply_fun g at h,
    -- now use `hgf` to turn `h` into `id a = id b`, and then
    -- use `h` to close the goal (note `id a` is definitionally `a`)
    rwa [hgf, hgf] at h, },
  { -- surjectivity
    intro y,
    use g y, -- pretty much the only element of x available!
    -- instead of rewrites let's use `change`
    change (f ∘ g) y = id y,
    rw hfg, },
end

-- The other way is harder in Lean, unless you know about the `choose`
-- tactic. Given `f` and a proof that it's a bijection, how do you
-- prove the existence of a two-sided inverse `g`? You'll have to construct
-- `g`, and the `choose` tactic does this for you.
-- If `hfs` is a proof that `f` is surjective, try `choose g hg using hfs`.
example : f.bijective → ∃ g : Y → X, f ∘ g = id ∧ g ∘ f = id :=
begin
  -- f is injective and surjective
  rintro ⟨hfi, hfs⟩,
  -- construct `g` a one-sided inverse (because `f` is surjective)
  choose g hg using hfs,
  -- now you have to use `hg` to prove both f ∘ g = id and g ∘ f = id
  use g,
  split,
  { -- f ∘ g is straightforward
    ext y, -- use functional extensionality
    exact hg y, },-- abuse of defeq
  { -- g ∘ f needs a trick
    ext x,
    -- here we use injectivity
    apply hfi,
    -- and here we abuse definitional equality
    exact hg (f x), },
end


/-
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
  split,
  { intro hST,
    exact ⟨mem_of_superset hST (inter_subset_left S T),
      mem_of_superset hST (inter_subset_right S T) ⟩, },
  { rintro ⟨hS, hT⟩,
    exact inter_mem hS hT }
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
    exact subset_univ _,
  end,
  sets_of_superset := begin
    intros S T hS hST,
    exact subset.trans hS hST,
  end,
  inter_sets := begin
    intros S T hS hT,
    exact subset_inter hS hT,
  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
    use e,
    rintros y -,
    exact mem_univ _,
  end,
  sets_of_superset := begin
    intros S T hS hST,
    simp only [mem_set_of_eq] at hS ⊢,
    obtain ⟨s, hs⟩ := hS,
    use s,
    intros x hx,
    exact hST (hs x hx),
  end,
  inter_sets := begin
    rintros S T ⟨s, hs⟩ ⟨t, ht⟩,
    use max s t,
    intros x hx,
    exact ⟨hs _ (le_trans (le_max_left s t) hx), ht _ (le_trans (le_max_right s t) hx)⟩,
  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
    simp only [mem_set_of_eq, compl_univ, finite_empty],
  end,
  sets_of_superset := begin
    intros S T hS hST,
    rw ← compl_subset_compl at hST,
    exact finite.subset hS hST,
  end,
  inter_sets := begin
    intros S T hS hT,
    rw [mem_set_of_eq, compl_inter],
    exact finite.union hS hT,
  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
  split; -- La siguiente instrucción se aplica a todas las metas abiertas (por el ;).
  intro hST,
  { rw ← mem_principal, -- Puedes comentarla y la prueba sigue funcionando
    rw le_def at hST,
    exact hST T (mem_principal_self T), },
  { intros X hX,
    rw mem_principal at hX ⊢, -- Puedes comentarla y la prueba sigue funcionando
    exact subset.trans hST hX, },
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
  rw le_def,
  exact ⟨λ h, h S (mem_principal_self S), λ h T hT, mem_of_superset h hT⟩,
end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Devon Tuma
-/
import analysis.asymptotics.asymptotic_equivalent
import analysis.asymptotics.specific_asymptotics
import data.polynomial.ring_division

/-!
# Limits related to polynomial and rational functions

This file proves basic facts about limits of polynomial and rationals functions.
The main result is `eval_is_equivalent_at_top_eval_lead`, which states that for
any polynomial `P` of degree `n` with leading coefficient `a`, the corresponding
polynomial function is equivalent to `a * x^n` as `x` goes to +∞.

We can then use this result to prove various limits for polynomial and rational
functions, depending on the degrees and leading coefficients of the considered
polynomials.
-/

open filter finset asymptotics
open_locale asymptotics polynomial topological_space

namespace polynomial

variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜] (P Q : 𝕜[X])

lemma eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in filter.at_top, ¬ P.is_root x :=
begin
  obtain ⟨x₀, hx₀⟩ := exists_max_root P hP,
  refine filter.eventually_at_top.mpr (⟨x₀ + 1, λ x hx h, _⟩),
  exact absurd (hx₀ x h) (not_le.mpr (lt_of_lt_of_le (lt_add_one x₀) hx)),
end

variables [order_topology 𝕜]

section polynomial_at_top

lemma is_equivalent_at_top_lead :
  (λ x, eval x P) ~[at_top] (λ x, P.leading_coeff * x ^ P.nat_degree) :=
begin
  by_cases h : P = 0,
  { simp [h] },
  { conv_lhs
    { funext,
      rw [polynomial.eval_eq_sum_range, sum_range_succ] },
    exact is_equivalent.refl.add_is_o (is_o.sum $ λ i hi, is_o.const_mul_left
      (is_o.const_mul_right (λ hz, h $ leading_coeff_eq_zero.mp hz) $
        is_o_pow_pow_at_top_of_lt (mem_range.mp hi)) _) }
end

lemma tendsto_at_top_of_leading_coeff_nonneg (hdeg : 1 ≤ P.degree) (hnng : 0 ≤ P.leading_coeff) :
  tendsto (λ x, eval x P) at_top at_top :=
P.is_equivalent_at_top_lead.symm.tendsto_at_top
  (tendsto_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnng $ ne.symm $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_top_iff_leading_coeff_nonneg :
  tendsto (λ x, eval x P) at_top at_top ↔ 1 ≤ P.degree ∧ 0 ≤ P.leading_coeff :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_top_of_leading_coeff_nonneg P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_top :=
    is_equivalent.tendsto_at_top (is_equivalent_at_top_lead P) h,
  rw tendsto_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2).symm), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma tendsto_at_bot_of_leading_coeff_nonpos (hdeg : 1 ≤ P.degree) (hnps : P.leading_coeff ≤ 0) :
  tendsto (λ x, eval x P) at_top at_bot :=
P.is_equivalent_at_top_lead.symm.tendsto_at_bot
  (tendsto_neg_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnps $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_bot_iff_leading_coeff_nonpos :
  tendsto (λ x, eval x P) at_top at_bot ↔ 1 ≤ P.degree ∧ P.leading_coeff ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_bot_of_leading_coeff_nonpos P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_bot :=
    (is_equivalent.tendsto_at_bot (is_equivalent_at_top_lead P) h),
  rw tendsto_neg_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2)), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma abs_tendsto_at_top (hdeg : 1 ≤ P.degree) :
  tendsto (λ x, abs $ eval x P) at_top at_top :=
begin
  by_cases hP : 0 ≤ P.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP)},
  { push_neg at hP,
    exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP.le)}
end

lemma abs_is_bounded_under_iff :
  is_bounded_under (≤) at_top (λ x, |eval x P|) ↔ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, ⟨|P.coeff 0|, eventually_map.mpr (eventually_of_forall
    (forall_imp (λ _, le_of_eq) (λ x, congr_arg abs $ trans (congr_arg (eval x)
    (eq_C_of_degree_le_zero h)) (eval_C))))⟩⟩,
  contrapose! h,
  exact not_is_bounded_under_of_tendsto_at_top
    (abs_tendsto_at_top P (nat.with_bot.one_le_iff_zero_lt.2 h))
end

lemma abs_tendsto_at_top_iff :
  tendsto (λ x, abs $ eval x P) at_top at_top ↔ 1 ≤ P.degree :=
⟨λ h, nat.with_bot.one_le_iff_zero_lt.2 (not_le.mp ((mt (abs_is_bounded_under_iff P).mpr)
  (not_is_bounded_under_of_tendsto_at_top h))), abs_tendsto_at_top P⟩

lemma tendsto_nhds_iff {c : 𝕜} :
  tendsto (λ x, eval x P) at_top (𝓝 c) ↔ P.leading_coeff = c ∧ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have := P.is_equivalent_at_top_lead.tendsto_nhds h,
    by_cases hP : P.leading_coeff = 0,
    { simp only [hP, zero_mul, tendsto_const_nhds_iff] at this,
      refine ⟨trans hP this, by simp [leading_coeff_eq_zero.1 hP]⟩ },
    { rw [tendsto_const_mul_pow_nhds_iff hP, nat_degree_eq_zero_iff_degree_le_zero] at this,
      exact this.symm } },
  { refine P.is_equivalent_at_top_lead.symm.tendsto_nhds _,
    have : P.nat_degree = 0 := nat_degree_eq_zero_iff_degree_le_zero.2 h.2,
    simp only [h.1, this, pow_zero, mul_one],
    exact tendsto_const_nhds }
end

end polynomial_at_top

section polynomial_div_at_top

lemma is_equivalent_at_top_div :
  (λ x, (eval x P)/(eval x Q)) ~[at_top]
    λ x, P.leading_coeff/Q.leading_coeff * x^(P.nat_degree - Q.nat_degree : ℤ) :=
begin
  by_cases hP : P = 0,
  { simp [hP] },
  by_cases hQ : Q = 0,
  { simp [hQ] },
  refine (P.is_equivalent_at_top_lead.symm.div
          Q.is_equivalent_at_top_lead.symm).symm.trans
         (eventually_eq.is_equivalent ((eventually_gt_at_top 0).mono $ λ x hx, _)),
  simp [← div_mul_div_comm₀, hP, hQ, zpow_sub₀ hx.ne.symm]
end

lemma div_tendsto_zero_of_degree_lt (hdeg : P.degree < Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) :=
begin
  by_cases hP : P = 0,
  { simp [hP, tendsto_const_nhds] },
  rw ←  nat_degree_lt_nat_degree_iff hP at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw ← mul_zero,
  refine (tendsto_zpow_at_top_zero _).const_mul _,
  linarith
end

lemma div_tendsto_zero_iff_degree_lt (hQ : Q ≠ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) ↔ P.degree < Q.degree :=
begin
  refine ⟨λ h, _, div_tendsto_zero_of_degree_lt P Q⟩,
  by_cases hPQ : P.leading_coeff / Q.leading_coeff = 0,
  { simp only [div_eq_mul_inv, inv_eq_zero, mul_eq_zero] at hPQ,
    cases hPQ with hP0 hQ0,
    { rw [leading_coeff_eq_zero.1 hP0, degree_zero],
      exact bot_lt_iff_ne_bot.2 (λ hQ', hQ (degree_eq_bot.1 hQ')) },
    { exact absurd (leading_coeff_eq_zero.1 hQ0) hQ } },
  { have := (is_equivalent_at_top_div P Q).tendsto_nhds h,
    rw tendsto_const_mul_zpow_at_top_zero_iff hPQ at this,
    cases this with h h,
    { exact absurd h.2 hPQ },
    { rw [sub_lt_iff_lt_add, zero_add, int.coe_nat_lt] at h,
      exact degree_lt_degree h.1 } }
end

lemma div_tendsto_leading_coeff_div_of_degree_eq (hdeg : P.degree = Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 $ P.leading_coeff / Q.leading_coeff) :=
begin
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw show (P.nat_degree : ℤ) = Q.nat_degree, by simp [hdeg, nat_degree],
  simp [tendsto_const_nhds]
end

lemma div_tendsto_at_top_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hpos : 0 < P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hpos, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_top _,
  apply tendsto.const_mul_at_top hpos,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnng : 0 ≤ P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
have ratio_pos : 0 < P.leading_coeff/Q.leading_coeff,
  from lt_of_le_of_ne hnng
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)).symm,
div_tendsto_at_top_of_degree_gt' P Q hdeg ratio_pos

lemma div_tendsto_at_bot_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hneg : P.leading_coeff/Q.leading_coeff < 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hneg, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_bot _,
  apply tendsto.neg_const_mul_at_top hneg,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_bot_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnps : P.leading_coeff/Q.leading_coeff ≤ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
have ratio_neg : P.leading_coeff/Q.leading_coeff < 0,
  from lt_of_le_of_ne hnps
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)),
div_tendsto_at_bot_of_degree_gt' P Q hdeg ratio_neg

lemma abs_div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) :
  tendsto (λ x, |(eval x P)/(eval x Q)|) at_top at_top :=
begin
  by_cases h : 0 ≤ P.leading_coeff/Q.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.div_tendsto_at_top_of_degree_gt Q hdeg hQ h) },
  { push_neg at h,
    exact tendsto_abs_at_bot_at_top.comp (P.div_tendsto_at_bot_of_degree_gt Q hdeg hQ h.le) }
end

end polynomial_div_at_top

theorem is_O_of_degree_le (h : P.degree ≤ Q.degree) :
  is_O (λ x, eval x P) (λ x, eval x Q) filter.at_top :=
begin
  by_cases hp : P = 0,
  { simpa [hp] using is_O_zero (λ x, eval x Q) filter.at_top },
  { have hq : Q ≠ 0 := ne_zero_of_degree_ge_degree h hp,
    have hPQ : ∀ᶠ (x : 𝕜) in at_top, eval x Q = 0 → eval x P = 0 :=
      filter.mem_of_superset (polynomial.eventually_no_roots Q hq) (λ x h h', absurd h' h),
    cases le_iff_lt_or_eq.mp h with h h,
    { exact is_O_of_div_tendsto_nhds hPQ 0 (div_tendsto_zero_of_degree_lt P Q h) },
    { exact is_O_of_div_tendsto_nhds hPQ _ (div_tendsto_leading_coeff_div_of_degree_eq P Q h) } }
end

end polynomial