/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Defines the inf/sup (semi)-lattice with optionally top/bot type class hierarchy.
-/

import order.basic

set_option old_structure_cmd true

universes u v w

-- TODO: move this eventually, if we decide to use them
attribute [ematch] le_trans lt_of_le_of_lt lt_of_lt_of_le lt_trans

section
  variable {α : Type u}

  -- TODO: this seems crazy, but it also seems to work reasonably well
  @[ematch] theorem le_antisymm' [partial_order α] : ∀ {a b : α}, (: a ≤ b :) → b ≤ a → a = b :=
  @le_antisymm _ _
end

/- TODO: automatic construction of dual definitions / theorems -/
namespace lattice

reserve infixl ` ⊓ `:70
reserve infixl ` ⊔ `:65

/-- Typeclass for the `⊔` (`\lub`) notation -/
class has_sup (α : Type u) := (sup : α → α → α)
/-- Typeclass for the `⊓` (`\glb`) notation -/
class has_inf (α : Type u) := (inf : α → α → α)

infix ⊔ := has_sup.sup
infix ⊓ := has_inf.inf

/-- A `semilattice_sup` is a join-semilattice, that is, a partial order
  with a join (a.k.a. lub / least upper bound, sup / supremum) operation
  `⊔` which is the least element larger than both factors. -/
class semilattice_sup (α : Type u) extends has_sup α, partial_order α :=
(le_sup_left : ∀ a b : α, a ≤ a ⊔ b)
(le_sup_right : ∀ a b : α, b ≤ a ⊔ b)
(sup_le : ∀ a b c : α, a ≤ c → b ≤ c → a ⊔ b ≤ c)

section semilattice_sup
variables {α : Type u} [semilattice_sup α] {a b c d : α}

@[simp] theorem le_sup_left : a ≤ a ⊔ b :=
semilattice_sup.le_sup_left a b

@[ematch] theorem le_sup_left' : a ≤ (: a ⊔ b :) :=
semilattice_sup.le_sup_left a b

@[simp] theorem le_sup_right : b ≤ a ⊔ b :=
semilattice_sup.le_sup_right a b

@[ematch] theorem le_sup_right' : b ≤ (: a ⊔ b :) :=
semilattice_sup.le_sup_right a b

theorem le_sup_left_of_le (h : c ≤ a) : c ≤ a ⊔ b :=
by finish

theorem le_sup_right_of_le (h : c ≤ b) : c ≤ a ⊔ b :=
by finish

theorem sup_le : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
semilattice_sup.sup_le a b c

@[simp] theorem sup_le_iff : a ⊔ b ≤ c ↔ a ≤ c ∧ b ≤ c :=
⟨assume h : a ⊔ b ≤ c, ⟨le_trans le_sup_left h, le_trans le_sup_right h⟩,
  assume ⟨h₁, h₂⟩, sup_le h₁ h₂⟩

-- TODO: if we just write le_antisymm, Lean doesn't know which ≤ we want to use
-- Can we do anything about that?
theorem sup_of_le_left (h : b ≤ a) : a ⊔ b = a :=
by apply le_antisymm; finish

theorem sup_of_le_right (h : a ≤ b) : a ⊔ b = b :=
by apply le_antisymm; finish

theorem sup_le_sup (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊔ c ≤ b ⊔ d :=
by finish

theorem sup_le_sup_left (h₁ : a ≤ b) (c) : c ⊔ a ≤ c ⊔ b :=
by finish

theorem sup_le_sup_right (h₁ : a ≤ b) (c) : a ⊔ c ≤ b ⊔ c :=
by finish

theorem le_of_sup_eq (h : a ⊔ b = b) : a ≤ b :=
by finish

@[simp] theorem sup_idem : a ⊔ a = a :=
by apply le_antisymm; finish

instance sup_is_idempotent : is_idempotent α (⊔) := ⟨@sup_idem _ _⟩

theorem sup_comm : a ⊔ b = b ⊔ a :=
by apply le_antisymm; finish

instance sup_is_commutative : is_commutative α (⊔) := ⟨@sup_comm _ _⟩

theorem sup_assoc : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
by apply le_antisymm; finish

instance sup_is_associative : is_associative α (⊔) := ⟨@sup_assoc _ _⟩

lemma forall_le_or_exists_lt_sup (a : α) : (∀b, b ≤ a) ∨ (∃b, a < b) :=
suffices (∃b, ¬b ≤ a) → (∃b, a < b),
  by rwa [classical.or_iff_not_imp_left, classical.not_forall],
assume ⟨b, hb⟩,
have a ≠ a ⊔ b, from assume eq, hb $ eq.symm ▸ le_sup_right,
⟨a ⊔ b, lt_of_le_of_ne le_sup_left ‹a ≠ a ⊔ b›⟩

theorem semilattice_sup.ext_sup {α} {A B : semilattice_sup α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y)
  (x y : α) : (by haveI := A; exact (x ⊔ y)) = x ⊔ y :=
eq_of_forall_ge_iff $ λ c,
by simp; rw [← H, @sup_le_iff α A, H, H]

theorem semilattice_sup.ext {α} {A B : semilattice_sup α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  haveI this := partial_order.ext H,
  have ss := funext (λ x, funext $ semilattice_sup.ext_sup H x),
  cases A; cases B; injection this; congr'
end

end semilattice_sup

/-- A `semilattice_inf` is a meet-semilattice, that is, a partial order
  with a meet (a.k.a. glb / greatest lower bound, inf / infimum) operation
  `⊓` which is the greatest element smaller than both factors. -/
class semilattice_inf (α : Type u) extends has_inf α, partial_order α :=
(inf_le_left : ∀ a b : α, a ⊓ b ≤ a)
(inf_le_right : ∀ a b : α, a ⊓ b ≤ b)
(le_inf : ∀ a b c : α, a ≤ b → a ≤ c → a ≤ b ⊓ c)

section semilattice_inf
variables {α : Type u} [semilattice_inf α] {a b c d : α}

@[simp] theorem inf_le_left : a ⊓ b ≤ a :=
semilattice_inf.inf_le_left a b

@[ematch] theorem inf_le_left' : (: a ⊓ b :) ≤ a :=
semilattice_inf.inf_le_left a b

@[simp] theorem inf_le_right : a ⊓ b ≤ b :=
semilattice_inf.inf_le_right a b

@[ematch] theorem inf_le_right' : (: a ⊓ b :) ≤ b :=
semilattice_inf.inf_le_right a b

theorem le_inf : a ≤ b → a ≤ c → a ≤ b ⊓ c :=
semilattice_inf.le_inf a b c

theorem inf_le_left_of_le (h : a ≤ c) : a ⊓ b ≤ c :=
le_trans inf_le_left h

theorem inf_le_right_of_le (h : b ≤ c) : a ⊓ b ≤ c :=
le_trans inf_le_right h

@[simp] theorem le_inf_iff : a ≤ b ⊓ c ↔ a ≤ b ∧ a ≤ c :=
⟨assume h : a ≤ b ⊓ c, ⟨le_trans h inf_le_left, le_trans h inf_le_right⟩,
  assume ⟨h₁, h₂⟩, le_inf h₁ h₂⟩

theorem inf_of_le_left (h : a ≤ b) : a ⊓ b = a :=
by apply le_antisymm; finish

theorem inf_of_le_right (h : b ≤ a) : a ⊓ b = b :=
by apply le_antisymm; finish

theorem inf_le_inf (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊓ c ≤ b ⊓ d :=
by finish

theorem le_of_inf_eq (h : a ⊓ b = a) : a ≤ b :=
by finish

@[simp] theorem inf_idem : a ⊓ a = a :=
by apply le_antisymm; finish

instance inf_is_idempotent : is_idempotent α (⊓) := ⟨@inf_idem _ _⟩

theorem inf_comm : a ⊓ b = b ⊓ a :=
by apply le_antisymm; finish

instance inf_is_commutative : is_commutative α (⊓) := ⟨@inf_comm _ _⟩

theorem inf_assoc : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) :=
by apply le_antisymm; finish

instance inf_is_associative : is_associative α (⊓) := ⟨@inf_assoc _ _⟩

lemma forall_le_or_exists_lt_inf (a : α) : (∀b, a ≤ b) ∨ (∃b, b < a) :=
suffices (∃b, ¬a ≤ b) → (∃b, b < a),
  by rwa [classical.or_iff_not_imp_left, classical.not_forall],
assume ⟨b, hb⟩,
have a ⊓ b ≠ a, from assume eq, hb $ eq ▸ inf_le_right,
⟨a ⊓ b, lt_of_le_of_ne inf_le_left ‹a ⊓ b ≠ a›⟩

theorem semilattice_inf.ext_inf {α} {A B : semilattice_inf α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y)
  (x y : α) : (by haveI := A; exact (x ⊓ y)) = x ⊓ y :=
eq_of_forall_le_iff $ λ c,
by simp; rw [← H, @le_inf_iff α A, H, H]

theorem semilattice_inf.ext {α} {A B : semilattice_inf α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  haveI this := partial_order.ext H,
  have ss := funext (λ x, funext $ semilattice_inf.ext_inf H x),
  cases A; cases B; injection this; congr'
end

end semilattice_inf

/- Lattices -/

/-- A lattice is a join-semilattice which is also a meet-semilattice. -/
class lattice (α : Type u) extends semilattice_sup α, semilattice_inf α

section lattice
variables {α : Type u} [lattice α] {a b c d : α}

/- Distributivity laws -/
/- TODO: better names? -/
theorem sup_inf_le : a ⊔ (b ⊓ c) ≤ (a ⊔ b) ⊓ (a ⊔ c) :=
by finish

theorem le_inf_sup : (a ⊓ b) ⊔ (a ⊓ c) ≤ a ⊓ (b ⊔ c) :=
by finish

theorem inf_sup_self : a ⊓ (a ⊔ b) = a :=
le_antisymm (by finish) (by finish)

theorem sup_inf_self : a ⊔ (a ⊓ b) = a :=
le_antisymm (by finish) (by finish)

theorem lattice.ext {α} {A B : lattice α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  have SS : @lattice.to_semilattice_sup α A =
            @lattice.to_semilattice_sup α B := semilattice_sup.ext H,
  have II := semilattice_inf.ext H,
  resetI, cases A; cases B; injection SS; injection II; congr'
end

end lattice

variables {α : Type u} {x y z w : α}

/-- A distributive lattice is a lattice that satisfies any of four
  equivalent distribution properties (of sup over inf or inf over sup,
  on the left or right). A classic example of a distributive lattice
  is the lattice of subsets of a set, and in fact this example is
  generic in the sense that every distributive lattice is realizable
  as a sublattice of a powerset lattice. -/
class distrib_lattice α extends lattice α :=
(le_sup_inf : ∀x y z : α, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z))

section distrib_lattice
variables [distrib_lattice α]

theorem le_sup_inf : ∀{x y z : α}, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z) :=
distrib_lattice.le_sup_inf

theorem sup_inf_left : x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z) :=
le_antisymm sup_inf_le le_sup_inf

theorem sup_inf_right : (y ⊓ z) ⊔ x = (y ⊔ x) ⊓ (z ⊔ x) :=
by simp [sup_inf_left, λy:α, @sup_comm α _ y x]

theorem inf_sup_left : x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z) :=
calc x ⊓ (y ⊔ z) = (x ⊓ (x ⊔ z)) ⊓ (y ⊔ z)       : by rw [inf_sup_self]
             ... = x ⊓ ((x ⊓ y) ⊔ z)             : by simp [inf_assoc, sup_inf_right]
             ... = (x ⊔ (x ⊓ y)) ⊓ ((x ⊓ y) ⊔ z) : by rw [sup_inf_self]
             ... = ((x ⊓ y) ⊔ x) ⊓ ((x ⊓ y) ⊔ z) : by rw [sup_comm]
             ... = (x ⊓ y) ⊔ (x ⊓ z)             : by rw [sup_inf_left]

theorem inf_sup_right : (y ⊔ z) ⊓ x = (y ⊓ x) ⊔ (z ⊓ x) :=
by simp [inf_sup_left, λy:α, @inf_comm α _ y x]

lemma eq_of_sup_eq_inf_eq {α : Type u} [distrib_lattice α] {a b c : α}
  (h₁ : b ⊓ a = c ⊓ a) (h₂ : b ⊔ a = c ⊔ a) : b = c :=
le_antisymm
  (calc b ≤ (c ⊓ a) ⊔ b     : le_sup_right
    ... = (c ⊔ b) ⊓ (a ⊔ b) : sup_inf_right
    ... = c ⊔ (c ⊓ a)       : by rw [←h₁, sup_inf_left, ←h₂]; simp [sup_comm]
    ... = c                 : sup_inf_self)
  (calc c ≤ (b ⊓ a) ⊔ c     : le_sup_right
    ... = (b ⊔ c) ⊓ (a ⊔ c) : sup_inf_right
    ... = b ⊔ (b ⊓ a)       : by rw [h₁, sup_inf_left, h₂]; simp [sup_comm]
    ... = b                 : sup_inf_self)

end distrib_lattice

/- Lattices derived from linear orders -/

instance lattice_of_decidable_linear_order {α : Type u} [o : decidable_linear_order α] : lattice α :=
{ sup          := max,
  le_sup_left  := le_max_left,
  le_sup_right := le_max_right,
  sup_le       := assume a b c, max_le,

  inf          := min,
  inf_le_left  := min_le_left,
  inf_le_right := min_le_right,
  le_inf       := assume a b c, le_min,
  ..o }

theorem sup_eq_max [decidable_linear_order α] : x ⊔ y = max x y := rfl
theorem inf_eq_min [decidable_linear_order α] : x ⊓ y = min x y := rfl

instance distrib_lattice_of_decidable_linear_order {α : Type u} [o : decidable_linear_order α] : distrib_lattice α :=
{ le_sup_inf := assume a b c,
    match le_total b c with
    | or.inl h := inf_le_left_of_le $ sup_le_sup_left (le_inf (le_refl b) h) _
    | or.inr h := inf_le_right_of_le $ sup_le_sup_left (le_inf h (le_refl c)) _
    end,
  ..lattice.lattice_of_decidable_linear_order }

instance nat.distrib_lattice : distrib_lattice ℕ :=
by apply_instance

end lattice

namespace order_dual
open lattice
variable (α : Type*)

instance [has_inf α] : has_sup (order_dual α) := ⟨((⊓) : α → α → α)⟩
instance [has_sup α] : has_inf (order_dual α) := ⟨((⊔) : α → α → α)⟩

instance [semilattice_inf α] : semilattice_sup (order_dual α) :=
{ le_sup_left  := @inf_le_left α _,
  le_sup_right := @inf_le_right α _,
  sup_le := assume a b c hca hcb, @le_inf α _ _ _ _ hca hcb,
  .. order_dual.partial_order α, .. order_dual.lattice.has_sup α }

instance [semilattice_sup α] : semilattice_inf (order_dual α) :=
{ inf_le_left  := @le_sup_left α _,
  inf_le_right := @le_sup_right α _,
  le_inf := assume a b c hca hcb, @sup_le α _ _ _ _ hca hcb,
  .. order_dual.partial_order α, .. order_dual.lattice.has_inf α }

instance [lattice α] : lattice (order_dual α) :=
{ .. order_dual.lattice.semilattice_sup α, .. order_dual.lattice.semilattice_inf α }

end order_dual


/-
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
-/
import analysis.normed_space.multilinear

/-!
# Formal multilinear series

In this file we define `formal_multilinear_series 𝕜 E F` to be a family of `n`-multilinear maps for
all `n`, designed to model the sequence of derivatives of a function. In other files we use this
notion to define `C^n` functions (called `cont_diff` in `mathlib`) and analytic functions.

## Notations

We use the notation `E [×n]→L[𝕜] F` for the space of continuous multilinear maps on `E^n` with
values in `F`. This is the space in which the `n`-th derivative of a function from `E` to `F` lives.

## Tags

multilinear, formal series
-/

noncomputable theory

open set fin
open_locale topological_space

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [normed_group G] [normed_space 𝕜 G]

/-- A formal multilinear series over a field `𝕜`, from `E` to `F`, is given by a family of
multilinear maps from `E^n` to `F` for all `n`. -/
@[derive add_comm_group]
def formal_multilinear_series
  (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
  (E : Type*) [normed_group E] [normed_space 𝕜 E]
  (F : Type*) [normed_group F] [normed_space 𝕜 F] :=
Π (n : ℕ), (E [×n]→L[𝕜] F)

instance : inhabited (formal_multilinear_series 𝕜 E F) := ⟨0⟩

section module
/- `derive` is not able to find the module structure, probably because Lean is confused by the
dependent types. We register it explicitly. -/
local attribute [reducible] formal_multilinear_series

instance : module 𝕜 (formal_multilinear_series 𝕜 E F) :=
begin
  letI : ∀ n, module 𝕜 (continuous_multilinear_map 𝕜 (λ (i : fin n), E) F) :=
    λ n, by apply_instance,
  apply_instance
end

end module

namespace formal_multilinear_series

variables (p : formal_multilinear_series 𝕜 E F)

/-- Forgetting the zeroth term in a formal multilinear series, and interpreting the following terms
as multilinear maps into `E →L[𝕜] F`. If `p` corresponds to the Taylor series of a function, then
`p.shift` is the Taylor series of the derivative of the function. -/
def shift : formal_multilinear_series 𝕜 E (E →L[𝕜] F) :=
λn, (p n.succ).curry_right

/-- Adding a zeroth term to a formal multilinear series taking values in `E →L[𝕜] F`. This
corresponds to starting from a Taylor series for the derivative of a function, and building a Taylor
series for the function itself. -/
def unshift (q : formal_multilinear_series 𝕜 E (E →L[𝕜] F)) (z : F) :
  formal_multilinear_series 𝕜 E F
| 0       := (continuous_multilinear_curry_fin0 𝕜 E F).symm z
| (n + 1) := continuous_multilinear_curry_right_equiv' 𝕜 n E F (q n)

/-- Killing the zeroth coefficient in a formal multilinear series -/
def remove_zero (p : formal_multilinear_series 𝕜 E F) : formal_multilinear_series 𝕜 E F
| 0       := 0
| (n + 1) := p (n + 1)

@[simp] lemma remove_zero_coeff_zero : p.remove_zero 0 = 0 := rfl

@[simp] lemma remove_zero_coeff_succ (n : ℕ) : p.remove_zero (n+1) = p (n+1) := rfl

lemma remove_zero_of_pos {n : ℕ} (h : 0 < n) : p.remove_zero n = p n :=
by { rw ← nat.succ_pred_eq_of_pos h, refl }

/-- Convenience congruence lemma stating in a dependent setting that, if the arguments to a formal
multilinear series are equal, then the values are also equal. -/
lemma congr (p : formal_multilinear_series 𝕜 E F) {m n : ℕ} {v : fin m → E} {w : fin n → E}
  (h1 : m = n) (h2 : ∀ (i : ℕ) (him : i < m) (hin : i < n), v ⟨i, him⟩ = w ⟨i, hin⟩) :
  p m v = p n w :=
by { cases h1, congr' with ⟨i, hi⟩, exact h2 i hi hi }

/-- Composing each term `pₙ` in a formal multilinear series with `(u, ..., u)` where `u` is a fixed
continuous linear map, gives a new formal multilinear series `p.comp_continuous_linear_map u`. -/
def comp_continuous_linear_map (p : formal_multilinear_series 𝕜 F G) (u : E →L[𝕜] F) :
  formal_multilinear_series 𝕜 E G :=
λ n, (p n).comp_continuous_linear_map (λ (i : fin n), u)

@[simp] lemma comp_continuous_linear_map_apply
  (p : formal_multilinear_series 𝕜 F G) (u : E →L[𝕜] F) (n : ℕ) (v : fin n → E) :
  (p.comp_continuous_linear_map u) n v = p n (u ∘ v) := rfl

variables (𝕜) {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜']
variables [normed_space 𝕜' E] [is_scalar_tower 𝕜 𝕜' E]
variables [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F]

/-- Reinterpret a formal `𝕜'`-multilinear series as a formal `𝕜`-multilinear series, where `𝕜'` is a
normed algebra over `𝕜`. -/
@[simp] protected def restrict_scalars (p : formal_multilinear_series 𝕜' E F) :
  formal_multilinear_series 𝕜 E F :=
λ n, (p n).restrict_scalars 𝕜

end formal_multilinear_series

namespace continuous_linear_map

/-- Composing each term `pₙ` in a formal multilinear series with a continuous linear map `f` on the
left gives a new formal multilinear series `f.comp_formal_multilinear_series p` whose general term
is `f ∘ pₙ`. -/
def comp_formal_multilinear_series (f : F →L[𝕜] G) (p : formal_multilinear_series 𝕜 E F) :
  formal_multilinear_series 𝕜 E G :=
λ n, f.comp_continuous_multilinear_map (p n)

@[simp] lemma comp_formal_multilinear_series_apply
  (f : F →L[𝕜] G) (p : formal_multilinear_series 𝕜 E F) (n : ℕ) :
  (f.comp_formal_multilinear_series p) n = f.comp_continuous_multilinear_map (p n) :=
rfl

lemma comp_formal_multilinear_series_apply'
  (f : F →L[𝕜] G) (p : formal_multilinear_series 𝕜 E F) (n : ℕ) (v : fin n → E) :
  (f.comp_formal_multilinear_series p) n v = f (p n v) :=
rfl

end continuous_linear_map


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

/-!
# Sheafification of `Type` valued presheaves

We construct the sheafification of a `Type` valued presheaf,
as the subsheaf of dependent functions into the stalks
consisting of functions which are locally germs.

We show that the stalks of the sheafification are isomorphic to the original stalks,
via `stalk_to_fiber` which evaluates a germ of a dependent function at a point.

We construct a morphism `to_sheafify` from a presheaf to (the underlying presheaf of)
its sheafification, given by sending a section to its collection of germs.

## Future work
Show that the map induced on stalks by `to_sheafify` is the inverse of `stalk_to_fiber`.

Show sheafification is a functor from presheaves to sheaves,
and that it is the left adjoint of the forgetful functor,
following <https://stacks.math.columbia.edu/tag/007X>.
-/

universes v

noncomputable theory

open Top
open opposite
open topological_space

variables {X : Top.{v}} (F : presheaf (Type v) X)

namespace Top.presheaf

namespace sheafify

/--
The prelocal predicate on functions into the stalks, asserting that the function is equal to a germ.
-/
def is_germ : prelocal_predicate (λ x, F.stalk x) :=
{ pred := λ U f, ∃ (g : F.obj (op U)), ∀ x : U, f x = F.germ x g,
  res := λ V U i f ⟨g, p⟩, ⟨F.map i.op g, λ x, (p (i x)).trans (F.germ_res_apply _ _ _).symm⟩, }

/--
The local predicate on functions into the stalks,
asserting that the function is locally equal to a germ.
-/
def is_locally_germ : local_predicate (λ x, F.stalk x) := (is_germ F).sheafify

end sheafify

/--
The sheafification of a `Type` valued presheaf, defined as the functions into the stalks which
are locally equal to germs.
-/
def sheafify : sheaf (Type v) X :=
subsheaf_to_Types (sheafify.is_locally_germ F)

/--
The morphism from a presheaf to its sheafification,
sending each section to its germs.
(This forms the unit of the adjunction.)
-/
def to_sheafify : F ⟶ F.sheafify.1 :=
{ app := λ U f, ⟨λ x, F.germ x f, prelocal_predicate.sheafify_of ⟨f, λ x, rfl⟩⟩,
  naturality' := λ U U' f, by { ext x ⟨u, m⟩, exact germ_res_apply F f.unop ⟨u, m⟩ x } }

/--
The natural morphism from the stalk of the sheafification to the original stalk.
In `sheafify_stalk_iso` we show this is an isomorphism.
-/
def stalk_to_fiber (x : X) : F.sheafify.presheaf.stalk x ⟶ F.stalk x :=
stalk_to_fiber (sheafify.is_locally_germ F) x

lemma stalk_to_fiber_surjective (x : X) : function.surjective (F.stalk_to_fiber x) :=
begin
  apply stalk_to_fiber_surjective,
  intro t,
  obtain ⟨U, m, s, rfl⟩ := F.germ_exist _ t,
  { use ⟨U, m⟩,
    fsplit,
    { exact λ y, F.germ y s, },
    { exact ⟨prelocal_predicate.sheafify_of ⟨s, (λ _, rfl)⟩, rfl⟩, }, },
end

lemma stalk_to_fiber_injective (x : X) : function.injective (F.stalk_to_fiber x) :=
begin
  apply stalk_to_fiber_injective,
  intros,
  rcases hU ⟨x, U.2⟩ with ⟨U', mU, iU, gU, wU⟩,
  rcases hV ⟨x, V.2⟩ with ⟨V', mV, iV, gV, wV⟩,
  have wUx := wU ⟨x, mU⟩,
  dsimp at wUx, erw wUx at e, clear wUx,
  have wVx := wV ⟨x, mV⟩,
  dsimp at wVx, erw wVx at e, clear wVx,
  rcases F.germ_eq x mU mV gU gV e with ⟨W, mW, iU', iV', e'⟩,
  dsimp at e',
  use ⟨W ⊓ (U' ⊓ V'), ⟨mW, mU, mV⟩⟩,
  refine ⟨_, _, _⟩,
  { change W ⊓ (U' ⊓ V') ⟶ U.obj,
    exact (opens.inf_le_right _ _) ≫ (opens.inf_le_left _ _) ≫ iU, },
  { change W ⊓ (U' ⊓ V') ⟶ V.obj,
    exact (opens.inf_le_right _ _) ≫ (opens.inf_le_right _ _) ≫ iV, },
  { intro w,
    dsimp,
    specialize wU ⟨w.1, w.2.2.1⟩,
    dsimp at wU,
    specialize wV ⟨w.1, w.2.2.2⟩,
    dsimp at wV,
    erw [wU, ←F.germ_res iU' ⟨w, w.2.1⟩, wV, ←F.germ_res iV' ⟨w, w.2.1⟩,
      category_theory.types_comp_apply, category_theory.types_comp_apply, e'] },
end

/--
The isomorphism betweeen a stalk of the sheafification and the original stalk.
-/
def sheafify_stalk_iso (x : X) : F.sheafify.presheaf.stalk x ≅ F.stalk x :=
(equiv.of_bijective _ ⟨stalk_to_fiber_injective _ _, stalk_to_fiber_surjective _ _⟩).to_iso

-- PROJECT functoriality, and that sheafification is the left adjoint of the forgetful functor.

end Top.presheaf


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Andrew Yang
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.preserves.basic

/-!
# Preserving pullbacks

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

Constructions to relate the notions of preserving pullbacks and reflecting pullbacks to concrete
pullback cones.

In particular, we show that `pullback_comparison G f g` is an isomorphism iff `G` preserves
the pullback of `f` and `g`.

The dual is also given.

## TODO

* Generalise to wide pullbacks

-/

noncomputable theory

universes v₁ v₂ u₁ u₂

open category_theory category_theory.category category_theory.limits

namespace category_theory.limits

section pullback

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D]
variables (G : C ⥤ D)
variables {W X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {h : W ⟶ X} {k : W ⟶ Y} (comm : h ≫ f = k ≫ g)

/-- The map of a pullback cone is a limit iff the fork consisting of the mapped morphisms is a
limit. This essentially lets us commute `pullback_cone.mk` with `functor.map_cone`. -/
def is_limit_map_cone_pullback_cone_equiv :
  is_limit (G.map_cone (pullback_cone.mk h k comm)) ≃
    is_limit (pullback_cone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm])
      : pullback_cone (G.map f) (G.map g)) :=
(is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₂} _) _).symm.trans $
is_limit.equiv_iso_limit $ cones.ext (iso.refl _) $
  (by rintro (_|_|_); dsimp; simp only [comp_id, id_comp, G.map_comp])

/-- The property of preserving pullbacks expressed in terms of binary fans. -/
def is_limit_pullback_cone_map_of_is_limit [preserves_limit (cospan f g) G]
  (l : is_limit (pullback_cone.mk h k comm)) :
  is_limit (pullback_cone.mk (G.map h) (G.map k) _) :=
is_limit_map_cone_pullback_cone_equiv G comm (preserves_limit.preserves l)

/-- The property of reflecting pullbacks expressed in terms of binary fans. -/
def is_limit_of_is_limit_pullback_cone_map [reflects_limit (cospan f g) G]
  (l : is_limit (pullback_cone.mk (G.map h) (G.map k) _)) :
  is_limit (pullback_cone.mk h k comm) :=
reflects_limit.reflects ((is_limit_map_cone_pullback_cone_equiv G comm).symm l)

variables (f g) [preserves_limit (cospan f g) G]

/-- If `G` preserves pullbacks and `C` has them, then the pullback cone constructed of the mapped
morphisms of the pullback cone is a limit. -/
def is_limit_of_has_pullback_of_preserves_limit [has_pullback f g] :
  is_limit (pullback_cone.mk (G.map pullback.fst) (G.map pullback.snd) _) :=
is_limit_pullback_cone_map_of_is_limit G _ (pullback_is_pullback f g)

/-- If `F` preserves the pullback of `f, g`, it also preserves the pullback of `g, f`. -/
def preserves_pullback_symmetry : preserves_limit (cospan g f) G :=
{ preserves := λ c hc,
  begin
    apply (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₂} _) _).to_fun,
    apply is_limit.of_iso_limit _ (pullback_cone.iso_mk _).symm,
    apply pullback_cone.flip_is_limit,
    apply (is_limit_map_cone_pullback_cone_equiv _ _).to_fun,
    { apply_with preserves_limit.preserves { instances := ff },
      { dsimp, apply_instance },
      apply pullback_cone.flip_is_limit,
      apply is_limit.of_iso_limit _ (pullback_cone.iso_mk _),
      exact (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₁} _) _).inv_fun hc },
    { exact (c.π.naturality walking_cospan.hom.inr).symm.trans
      (c.π.naturality walking_cospan.hom.inl : _) }
  end }

lemma has_pullback_of_preserves_pullback [has_pullback f g] :
  has_pullback (G.map f) (G.map g) :=
⟨⟨⟨_, is_limit_pullback_cone_map_of_is_limit G _ (pullback_is_pullback _ _)⟩⟩⟩

variables [has_pullback f g] [has_pullback (G.map f) (G.map g)]

/-- If `G` preserves the pullback of `(f,g)`, then the pullback comparison map for `G` at `(f,g)` is
an isomorphism. -/
def preserves_pullback.iso :
  G.obj (pullback f g) ≅ pullback (G.map f) (G.map g) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_pullback_of_preserves_limit G f g)
  (limit.is_limit _)

@[reassoc] lemma preserves_pullback.iso_hom_fst :
  (preserves_pullback.iso G f g).hom ≫ pullback.fst = G.map pullback.fst :=
by simp [preserves_pullback.iso]

@[reassoc] lemma preserves_pullback.iso_hom_snd :
  (preserves_pullback.iso G f g).hom ≫ pullback.snd = G.map pullback.snd :=
by simp [preserves_pullback.iso]

@[simp, reassoc] lemma preserves_pullback.iso_inv_fst :
  (preserves_pullback.iso G f g).inv ≫ G.map pullback.fst = pullback.fst :=
by simp [preserves_pullback.iso, iso.inv_comp_eq]

@[simp, reassoc]

end pullback

section pushout

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D]
variables (G : C ⥤ D)
variables {W X Y Z : C} {h : X ⟶ Z} {k : Y ⟶ Z} {f : W ⟶ X} {g : W ⟶ Y} (comm : f ≫ h = g ≫ k)

/-- The map of a pushout cocone is a colimit iff the cofork consisting of the mapped morphisms is a
colimit. This essentially lets us commute `pushout_cocone.mk` with `functor.map_cocone`. -/
def is_colimit_map_cocone_pushout_cocone_equiv :
  is_colimit (G.map_cocone (pushout_cocone.mk h k comm)) ≃
    is_colimit (pushout_cocone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm])
      : pushout_cocone (G.map f) (G.map g)) :=
(is_colimit.precompose_hom_equiv (diagram_iso_span.{v₂} _).symm _).symm.trans $
is_colimit.equiv_iso_colimit $ cocones.ext (iso.refl _) $
  (by rintro (_|_|_); dsimp; simp only [category.comp_id, category.id_comp, ← G.map_comp])

/-- The property of preserving pushouts expressed in terms of binary cofans. -/
def is_colimit_pushout_cocone_map_of_is_colimit [preserves_colimit (span f g) G]
  (l : is_colimit (pushout_cocone.mk h k comm)) :
  is_colimit (pushout_cocone.mk (G.map h) (G.map k) _) :=
is_colimit_map_cocone_pushout_cocone_equiv G comm (preserves_colimit.preserves l)

/-- The property of reflecting pushouts expressed in terms of binary cofans. -/
def is_colimit_of_is_colimit_pushout_cocone_map [reflects_colimit (span f g) G]
  (l : is_colimit (pushout_cocone.mk (G.map h) (G.map k) _)) :
  is_colimit (pushout_cocone.mk h k comm) :=
reflects_colimit.reflects ((is_colimit_map_cocone_pushout_cocone_equiv G comm).symm l)

variables (f g) [preserves_colimit (span f g) G]

/-- If `G` preserves pushouts and `C` has them, then the pushout cocone constructed of the mapped
morphisms of the pushout cocone is a colimit. -/
def is_colimit_of_has_pushout_of_preserves_colimit [has_pushout f g] :
  is_colimit (pushout_cocone.mk (G.map pushout.inl) (G.map pushout.inr) _) :=
is_colimit_pushout_cocone_map_of_is_colimit G _ (pushout_is_pushout f g)

/-- If `F` preserves the pushout of `f, g`, it also preserves the pushout of `g, f`. -/
def preserves_pushout_symmetry : preserves_colimit (span g f) G :=
{ preserves := λ c hc,
  begin
    apply (is_colimit.precompose_hom_equiv (diagram_iso_span.{v₂} _).symm _).to_fun,
    apply is_colimit.of_iso_colimit _ (pushout_cocone.iso_mk _).symm,
    apply pushout_cocone.flip_is_colimit,
    apply (is_colimit_map_cocone_pushout_cocone_equiv _ _).to_fun,
    { apply_with preserves_colimit.preserves { instances := ff },
      { dsimp, apply_instance },
      apply pushout_cocone.flip_is_colimit,
      apply is_colimit.of_iso_colimit _ (pushout_cocone.iso_mk _),
      exact (is_colimit.precompose_hom_equiv (diagram_iso_span.{v₁} _) _).inv_fun hc },
    { exact (c.ι.naturality walking_span.hom.snd).trans
      (c.ι.naturality walking_span.hom.fst).symm }
  end }

lemma has_pushout_of_preserves_pushout [has_pushout f g] :
  has_pushout (G.map f) (G.map g) :=
⟨⟨⟨_, is_colimit_pushout_cocone_map_of_is_colimit G _ (pushout_is_pushout _ _)⟩⟩⟩

variables [has_pushout f g]  [has_pushout (G.map f) (G.map g)]

/-- If `G` preserves the pushout of `(f,g)`, then the pushout comparison map for `G` at `(f,g)` is
an isomorphism. -/
def preserves_pushout.iso :
  pushout (G.map f) (G.map g) ≅ G.obj (pushout f g) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (is_colimit_of_has_pushout_of_preserves_colimit G f g)

@[reassoc] lemma preserves_pushout.inl_iso_hom :
  pushout.inl ≫ (preserves_pushout.iso G f g).hom = G.map pushout.inl :=
by { delta preserves_pushout.iso, simp }

@[reassoc] lemma preserves_pushout.inr_iso_hom :
  pushout.inr ≫ (preserves_pushout.iso G f g).hom = G.map pushout.inr :=
by { delta preserves_pushout.iso, simp }

@[simp, reassoc] lemma preserves_pushout.inl_iso_inv :
  G.map pushout.inl ≫ (preserves_pushout.iso G f g).inv = pushout.inl :=
by simp [preserves_pushout.iso, iso.comp_inv_eq]

@[simp, reassoc] lemma preserves_pushout.inr_iso_inv :
  G.map pushout.inr ≫ (preserves_pushout.iso G f g).inv = pushout.inr :=
by simp [preserves_pushout.iso, iso.comp_inv_eq]

end pushout

section

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₁} D]
variables (G : C ⥤ D)

section pullback

variables {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
variables [has_pullback f g] [has_pullback (G.map f) (G.map g)]

/-- If the pullback comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
pullback of `(f,g)`. -/
def preserves_pullback.of_iso_comparison [i : is_iso (pullback_comparison G f g)] :
  preserves_limit (cospan f g) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (pullback_is_pullback f g),
  apply (is_limit_map_cone_pullback_cone_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (cospan (G.map f) (G.map g))),
  apply i,
end

variable [preserves_limit (cospan f g) G]

@[simp]
lemma preserves_pullback.iso_hom :
  (preserves_pullback.iso G f g).hom = pullback_comparison G f g := rfl

instance : is_iso (pullback_comparison G f g) :=
begin
  rw ← preserves_pullback.iso_hom,
  apply_instance
end

end pullback

section pushout

variables {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z}
variables [has_pushout f g] [has_pushout (G.map f) (G.map g)]

/-- If the pushout comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
pushout of `(f,g)`. -/
def preserves_pushout.of_iso_comparison [i : is_iso (pushout_comparison G f g)] :
  preserves_colimit (span f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (pushout_is_pushout f g),
  apply (is_colimit_map_cocone_pushout_cocone_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (span (G.map f) (G.map g))),
  apply i,
end

variable [preserves_colimit (span f g) G]

@[simp]
lemma preserves_pushout.iso_hom :
  (preserves_pushout.iso G f g).hom = pushout_comparison G f g := rfl

instance : is_iso (pushout_comparison G f g) :=
begin
  rw ← preserves_pushout.iso_hom,
  apply_instance
end

end pushout

end

end category_theory.limits


theorem foo (x : Nat) (h : x > 0) : x ≠ 0 :=
  match x with
  | 0   => sorry
  | h+1 => sorry

inductive Mem : α → List α → Prop where
 | head (a : α) (as : List α)   : Mem a (a::as)
 | tail (a b : α) (bs : List α) : Mem a bs → Mem a (b::bs)
infix:50 "∈" => Mem

theorem mem_split {a : α} {as : List α} (h : a ∈ as) : ∃ s t, as = s ++ a :: t := by
  induction as with
  | nil          => cases h
  | cons b bs ih => cases h with
    | head a bs => exact ⟨[], ⟨bs, rfl⟩⟩
    | tail a b bs h =>
      match bs, ih h with
      | _, ⟨s, t, rfl⟩ =>
        exists b::s; exists t
        rw [List.cons_append]


import data.list.basic

universe u
variable {α : Type}
open list

example (xs : list ℕ) :
  reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ reverse xs :=
  by simp

example (xs ys : list α) :
  length (reverse (xs ++ ys)) = length xs + length ys :=
  by simp [add_comm]
-- lean 3.6 removes simp attributes from add_comm
-- i.e., now it is required to provide that lemma to solve this example.


import tactic
import data.int.parity
import data.int.modeq
import data.nat.factorization.basic
import number_theory.legendre_symbol.quadratic_reciprocity

import Mordell.CongruencesMod4

--medium(ish)

def is_cube (n : ℤ) : Prop := ∃ (m : ℤ), n = m^3

lemma diff_of_cubes (n m : ℤ) (hn : is_cube n) (hm : is_cube m) (hn2 : odd n) (hm2 : odd m) :
  n - m ≠ 8 :=
begin
  sorry,
end

lemma consecutive_cubes (n : ℤ) (hn : is_cube n) (hn1 : is_cube (n+1)) : n = -1 ∨ n = 0 :=
begin
left,
sorry,
end

example (x y : ℤ) (h : y^2 = x^3 + 16) : x = 0 ∧ (y.nat_abs = 4) :=
begin
 have h₀ : x^3 = (y - 4) * (y + 4),
 {  have h₁ : x^3 = y^2 - 16,
    { rw h,
      ring},
    rw h₁,
    ring},
 have eveny : even y,
 {  sorry},
 have evenx : even x,
 {  cases eveny,
    rw eveny_h at h,
    have h₁ : (2*  eveny_w) ^ 2 = x ^ 3 + 16,
    {  rw ← h,
      ring},
    have h₂ : 4 * eveny_w ^ 2 = x^3 + 16,
    { rw ← h₁,
      ring},
    have h₃ : 4 * eveny_w^2 - 16 = x^3,
    { rw h₂,
      ring},
    have h₄ : (2* eveny_w^2 - 8) + (2* eveny_w^2 - 8) = x^3,
      { rw ← h₃,
        ring},
    clear h₁ h₂ h₃,
    have h₅ : even (x^3),
    { unfold even,
      use 2* eveny_w^2 - 8,
      rw h₄},
    rw int.even_pow' at h₅,
    swap,
    norm_num,
    assumption},
 have h4y : 4 ∣ y,
 {  have h₁: 8 ∣ (x^3 + 16),
    { cases evenx,
      rw evenx_h,
      ring_nf,
      have h₂ : 8 * evenx_w^3 + 16 = 8 * (evenx_w^3 +2) := by ring,
      rw h₂,
      exact dvd.intro (evenx_w ^ 3 + 2) rfl},
  have h₂ : 8 ∣ y^2 := by rwa h,
  rw even_iff_exists_two_nsmul at eveny,
  simp at eveny,
  obtain⟨a, ha⟩:= eveny,
  rw ha at ⊢ h₂,
  have h₅ := int.mul_div_cancel' h₂,
  have h₆: (2 : ℤ)^2 * a^2 = (2*a)^2 := by ring,
  rw ← h₆ at h₅,
  have h₇ : 2^2 * (2 ^ 2 * a ^2 / 2 ^ 3) = 2 * a ^ 2,
  { norm_num at h₅ ⊢,
    have htemp : (8 : ℤ) = 2 * 4 := by norm_num,
    have htemp2 : (4 : ℤ) = 2 * 2 := by norm_num,
    rw htemp at h₅,
    rw htemp2 at h₅,
    simp_rw mul_assoc at h₅,
    have h₈ : (2 : ℤ) ≠ 0 := by exact two_ne_zero,
    have := mul_left_cancel₀ h₈ h₅,
    rw ← this,
    ring_nf},
  have h₉ : 2 * (2 ^ 2 * a ^2 / 2 ^ 3) = a ^ 2,
  { norm_num at h₇ ⊢,
    have htemp : (8 : ℤ) = 2 * 4 := by norm_num,
    have htemp2 : (4 : ℤ) = 2 * 2 := by norm_num,
    rw htemp at h₇,
    rw htemp2 at h₇,
    simp_rw mul_assoc at h₇,
    have h₈ : (2 : ℤ) ≠ 0 := by exact two_ne_zero,
    have := mul_left_cancel₀ h₈ h₇,
    rw ← this,
    simp,
    ring_nf,
    apply int.mul_div_cancel_left,
    norm_num},
    norm_num at h₉,
    have := dvd.intro (4 * a ^ 2 / 8) h₉,
    have := prime.dvd_of_dvd_pow int.prime_two this,
    have : (4 : ℤ) = 2 * 2 := by norm_num,
    rw this,
    apply mul_dvd_mul_left,
    assumption,},
 have h4x : 4 ∣ x,
 {  have h₁ := int.mul_div_cancel' h4y,
    rw ← h₁ at h,
    rw mul_pow at h,
    norm_num at h,
    have h₂ : 16 * ((y/4)^2 - 1) = x^3,
    { have htemp : 16 * (y/4)^2 - 16 = x^3,
      { rw h,
        ring},
      rw ← htemp,
      ring},
    have h16x3 := dvd.intro ((y/4)^2 - 1) h₂,
    have h₃ := int.mul_div_cancel' h16x3,
    obtain⟨a, ha⟩:= evenx,
    rw ha at h₃,

    sorry},
 sorry,
end


import data.nat.basic

example (a b : ℕ) (h : a ≠ b) : b ≠ a :=
begin
  symmetry,
  exact h,
end


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import .mathlib
import combinatorics.choose.bounds
import data.sym.card

/-!
# Index
-/

open_locale big_operators
open finset fintype function relation

variables {α : Type*}

/-! ## finpartition.is_uniform -/

variables [decidable_eq α] {s : finset α} (P : finpartition s)
variables (G : simple_graph α) [decidable_rel G.adj]

namespace finpartition
open_locale classical
open finset

noncomputable def non_uniform_pairs (ε : ℝ) :
  finset (finset α × finset α) :=
P.parts.off_diag.filter (λ UV, ¬G.is_uniform ε UV.1 UV.2)

lemma mem_non_uniform_pairs (U V : finset α) (ε : ℝ) :
  (U, V) ∈ P.non_uniform_pairs G ε ↔ U ∈ P.parts ∧ V ∈ P.parts ∧ U ≠ V ∧ ¬G.is_uniform ε U V :=
by rw [non_uniform_pairs, mem_filter, mem_off_diag, and_assoc, and_assoc]

/-- An finpartition is `ε-uniform` iff at most a proportion of `ε` of its pairs of parts are not
`ε-uniform`. -/
def is_uniform (ε : ℝ) : Prop :=
((P.non_uniform_pairs G ε).card : ℝ) ≤ (P.parts.card * (P.parts.card - 1) : ℕ) * ε

lemma empty_is_uniform {P : finpartition s} {G : simple_graph α} {ε : ℝ} (hP : P.parts = ∅) :
  P.is_uniform G ε :=
by simp [is_uniform, hP, non_uniform_pairs]

lemma nonempty_of_not_uniform {P : finpartition s} {G : simple_graph α} {ε : ℝ}
  (h : ¬ P.is_uniform G ε) : P.parts.nonempty :=
nonempty_of_ne_empty (λ h₁, h (empty_is_uniform h₁))

lemma is_uniform_of_one_le {ε : ℝ} (hε : 1 ≤ ε) : P.is_uniform G ε :=
begin
  apply le_trans _ (mul_le_mul_of_nonneg_left hε (nat.cast_nonneg _)),
  rw [mul_one, nat.cast_le],
  apply le_trans (card_filter_le _ _),
  rw [off_diag_card, nat.mul_sub_left_distrib, mul_one],
end

/-- The energy is the auxiliary quantity that drives the induction process in the proof of
Szemerédi's Regularity Lemma (see `increment`). As long as we do not have a suitable equipartition,
we will find a new one that has an energy greater than the previous one plus some fixed constant.
Then `energy_le_one` ensures this process only happens finitely many times. -/
noncomputable def energy (P : finpartition s) : ℝ :=
(∑ UV in P.parts.off_diag, G.edge_density UV.1 UV.2^2)/P.parts.card^2

lemma energy_nonneg (P : finpartition s) : 0 ≤ P.energy G :=
div_nonneg (finset.sum_nonneg (λ _ _, sq_nonneg _)) (sq_nonneg _)

lemma energy_le_one (P : finpartition s) : P.energy G ≤ 1 :=
begin
  refine div_le_of_nonneg_of_le_mul (sq_nonneg _) zero_le_one _,
  suffices h : ∑ UV in P.parts.off_diag, G.edge_density UV.1 UV.2^2 ≤ P.parts.off_diag.card,
  { apply h.trans,
    rw [off_diag_card, one_mul, ←nat.cast_pow, nat.cast_le, sq],
    apply tsub_le_self },
  rw ←nat.smul_one_eq_coe,
  refine sum_le_of_forall_le _ _ 1 (λ UV _, _),
  rw sq_le_one_iff (G.edge_density_nonneg _ _),
  exact G.edge_density_le_one _ _,
end

lemma non_uniform_pairs_bot {ε : ℝ} (hε : 0 < ε) : (⊥ : finpartition s).non_uniform_pairs G ε = ∅ :=
begin
  rw eq_empty_iff_forall_not_mem,
  rintro ⟨U, V⟩,
  simp only [finpartition.mem_non_uniform_pairs, finpartition.parts_bot, mem_map,
    not_and, not_not, embedding.coe_fn_mk, exists_imp_distrib],
  rintro x hx rfl y hy rfl h,
  exact G.is_uniform_singleton hε,
end

lemma bot_is_uniform {ε : ℝ} (hε : 0 < ε) : (⊥ : finpartition s).is_uniform G ε :=
begin
  rw [finpartition.is_uniform, finpartition.card_bot, non_uniform_pairs_bot _ hε,
    finset.card_empty, nat.cast_zero],
  exact mul_nonneg (nat.cast_nonneg _) hε.le,
end

end finpartition


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

! This file was ported from Lean 3 source module data.vector.mem
! 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.Vector.Basic

/-!
# Theorems about membership of elements in vectors

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

This file contains theorems for membership in a `v.to_list` for a vector `v`.
Having the length available in the type allows some of the lemmas to be
  simpler and more general than the original version for lists.
In particular we can avoid some assumptions about types being `inhabited`,
  and make more general statements about `head` and `tail`.
-/

namespace Vector

variable {α β : Type _} {n : ℕ} (a a' : α)

#print Vector.get_mem /-
@[simp]
theorem get_mem (i : Fin n) (v : Vector α n) : v.get? i ∈ v.toList :=
  by
  rw [nth_eq_nth_le]
  exact List.nthLe_mem _ _ _
#align vector.nth_mem Vector.get_mem
-/

#print Vector.mem_iff_get /-
theorem mem_iff_get (v : Vector α n) : a ∈ v.toList ↔ ∃ i, v.get? i = a := by
  simp only [List.mem_iff_nthLe, Fin.exists_iff, Vector.get_eq_get] <;>
    exact
      ⟨fun ⟨i, hi, h⟩ => ⟨i, by rwa [to_list_length] at hi, h⟩, fun ⟨i, hi, h⟩ =>
        ⟨i, by rwa [to_list_length], h⟩⟩
#align vector.mem_iff_nth Vector.mem_iff_get
-/

#print Vector.not_mem_nil /-
theorem not_mem_nil : a ∉ (Vector.nil : Vector α 0).toList :=
  id
#align vector.not_mem_nil Vector.not_mem_nil
-/

#print Vector.not_mem_zero /-
theorem not_mem_zero (v : Vector α 0) : a ∉ v.toList :=
  (Vector.eq_nil v).symm ▸ not_mem_nil a
#align vector.not_mem_zero Vector.not_mem_zero
-/

#print Vector.mem_cons_iff /-
theorem mem_cons_iff (v : Vector α n) : a' ∈ (a ::ᵥ v).toList ↔ a' = a ∨ a' ∈ v.toList := by
  rw [Vector.toList_cons, List.mem_cons]
#align vector.mem_cons_iff Vector.mem_cons_iff
-/

#print Vector.mem_succ_iff /-
theorem mem_succ_iff (v : Vector α (n + 1)) : a ∈ v.toList ↔ a = v.headI ∨ a ∈ v.tail.toList :=
  by
  obtain ⟨a', v', h⟩ := exists_eq_cons v
  simp_rw [h, Vector.mem_cons_iff, Vector.head_cons, Vector.tail_cons]
#align vector.mem_succ_iff Vector.mem_succ_iff
-/

#print Vector.mem_cons_self /-
theorem mem_cons_self (v : Vector α n) : a ∈ (a ::ᵥ v).toList :=
  (Vector.mem_iff_get a (a ::ᵥ v)).2 ⟨0, Vector.get_cons_zero a v⟩
#align vector.mem_cons_self Vector.mem_cons_self
-/

#print Vector.head_mem /-
@[simp]
theorem head_mem (v : Vector α (n + 1)) : v.headI ∈ v.toList :=
  (Vector.mem_iff_get v.headI v).2 ⟨0, Vector.get_zero v⟩
#align vector.head_mem Vector.head_mem
-/

#print Vector.mem_cons_of_mem /-
theorem mem_cons_of_mem (v : Vector α n) (ha' : a' ∈ v.toList) : a' ∈ (a ::ᵥ v).toList :=
  (Vector.mem_cons_iff a a' v).2 (Or.inr ha')
#align vector.mem_cons_of_mem Vector.mem_cons_of_mem
-/

#print Vector.mem_of_mem_tail /-
theorem mem_of_mem_tail (v : Vector α n) (ha : a ∈ v.tail.toList) : a ∈ v.toList :=
  by
  induction' n with n hn
  · exact False.elim (Vector.not_mem_zero a v.tail ha)
  · exact (mem_succ_iff a v).2 (Or.inr ha)
#align vector.mem_of_mem_tail Vector.mem_of_mem_tail
-/

/- warning: vector.mem_map_iff -> Vector.mem_map_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {n : Nat} (b : β) (v : Vector.{u1} α n) (f : α -> β), Iff (Membership.Mem.{u2, u2} β (List.{u2} β) (List.hasMem.{u2} β) b (Vector.toList.{u2} β n (Vector.map.{u1, u2} α β n f v))) (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a (Vector.toList.{u1} α n v)) (Eq.{succ u2} β (f a) b)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {n : Nat} (b : β) (v : Vector.{u2} α n) (f : α -> β), Iff (Membership.mem.{u1, u1} β (List.{u1} β) (List.instMembershipList.{u1} β) b (Vector.toList.{u1} β n (Vector.map.{u2, u1} α β n f v))) (Exists.{succ u2} α (fun (a : α) => And (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a (Vector.toList.{u2} α n v)) (Eq.{succ u1} β (f a) b)))
Case conversion may be inaccurate. Consider using '#align vector.mem_map_iff Vector.mem_map_iffₓ'. -/
theorem mem_map_iff (b : β) (v : Vector α n) (f : α → β) :
    b ∈ (v.map f).toList ↔ ∃ a : α, a ∈ v.toList ∧ f a = b := by
  rw [Vector.toList_map, List.mem_map]
#align vector.mem_map_iff Vector.mem_map_iff

/- warning: vector.not_mem_map_zero -> Vector.not_mem_map_zero is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (b : β) (v : Vector.{u1} α (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) (f : α -> β), Not (Membership.Mem.{u2, u2} β (List.{u2} β) (List.hasMem.{u2} β) b (Vector.toList.{u2} β (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (Vector.map.{u1, u2} α β (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) f v)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (b : β) (v : Vector.{u2} α (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) (f : α -> β), Not (Membership.mem.{u1, u1} β (List.{u1} β) (List.instMembershipList.{u1} β) b (Vector.toList.{u1} β (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (Vector.map.{u2, u1} α β (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) f v)))
Case conversion may be inaccurate. Consider using '#align vector.not_mem_map_zero Vector.not_mem_map_zeroₓ'. -/
theorem not_mem_map_zero (b : β) (v : Vector α 0) (f : α → β) : b ∉ (v.map f).toList := by
  simpa only [Vector.eq_nil v, Vector.map_nil, Vector.toList_nil] using List.not_mem_nil b
#align vector.not_mem_map_zero Vector.not_mem_map_zero

/- warning: vector.mem_map_succ_iff -> Vector.mem_map_succ_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {n : Nat} (b : β) (v : Vector.{u1} α (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (f : α -> β), Iff (Membership.Mem.{u2, u2} β (List.{u2} β) (List.hasMem.{u2} β) b (Vector.toList.{u2} β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Vector.map.{u1, u2} α β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) f v))) (Or (Eq.{succ u2} β (f (Vector.head.{u1} α n v)) b) (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a (Vector.toList.{u1} α (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Vector.tail.{u1} α (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) v))) (Eq.{succ u2} β (f a) b))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {n : Nat} (b : β) (v : Vector.{u2} α (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (f : α -> β), Iff (Membership.mem.{u1, u1} β (List.{u1} β) (List.instMembershipList.{u1} β) b (Vector.toList.{u1} β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Vector.map.{u2, u1} α β (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) f v))) (Or (Eq.{succ u1} β (f (Vector.head.{u2} α n v)) b) (Exists.{succ u2} α (fun (a : α) => And (Membership.mem.{u2, u2} α (List.{u2} α) (List.instMembershipList.{u2} α) a (Vector.toList.{u2} α (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Vector.tail.{u2} α (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) v))) (Eq.{succ u1} β (f a) b))))
Case conversion may be inaccurate. Consider using '#align vector.mem_map_succ_iff Vector.mem_map_succ_iffₓ'. -/
theorem mem_map_succ_iff (b : β) (v : Vector α (n + 1)) (f : α → β) :
    b ∈ (v.map f).toList ↔ f v.headI = b ∨ ∃ a : α, a ∈ v.tail.toList ∧ f a = b := by
  rw [mem_succ_iff, head_map, tail_map, mem_map_iff, @eq_comm _ b]
#align vector.mem_map_succ_iff Vector.mem_map_succ_iff

end Vector


import Logic.Vorspiel.Notation
import Mathlib.Tactic.LibrarySearch
import Mathlib.Data.Fin.Basic
import Mathlib.Data.Fin.VecNotation
import Mathlib.Data.Fintype.Basic
import Mathlib.Data.Finset.Basic
import Mathlib.Data.Finset.Lattice
import Mathlib.Data.Finset.Preimage
import Mathlib.Data.Finset.Sort
import Mathlib.Data.W.Basic
import Mathlib.Order.Filter.Ultrafilter

namespace Nat
variable {α : ℕ → Sort u}

def cases (hzero : α 0) (hsucc : ∀ n, α (n + 1)) : ∀ n, α n
  | 0     => hzero
  | n + 1 => hsucc n

infixr:70 " :>ₙ " => cases

@[simp] lemma cases_zero (hzero : α 0) (hsucc : ∀ n, α (n + 1)) :
    (hzero :>ₙ hsucc) 0 = hzero := rfl

@[simp] lemma cases_succ (hzero : α 0) (hsucc : ∀ n, α (n + 1)) (n : ℕ) :
    (hzero :>ₙ hsucc) (n + 1) = hsucc n := rfl

end Nat

lemma eq_finZeroElim {α : Sort u} (x : Fin 0 → α) : x = finZeroElim := funext (by rintro ⟨_, _⟩; contradiction)

namespace Matrix
open Fin
section
variable {n : ℕ} {α : Type u}

infixr:70 " :> " => vecCons

@[simp] lemma vecCons_zero :
    (a :> s) 0 = a := by simp

@[simp] lemma vecCons_succ (i : Fin n) :
    (a :> s) (Fin.succ i) = s i := by simp

@[simp] lemma vecCons_last (a : C) (s : Fin (n + 1) → C) :
    (a :> s) (Fin.last (n + 1)) = s (Fin.last n) := vecCons_succ (Fin.last n)

def vecConsLast {n : ℕ} (t : Fin n → α) (h : α) : Fin n.succ → α :=
  Fin.lastCases h t

infixl:70 " <: " => vecConsLast

@[simp] lemma rightConcat_last :
    (s <: a) (last n) = a := by simp[vecConsLast]

@[simp] lemma rightConcat_castSucc (i : Fin n) :
    (s <: a) (Fin.castSucc i) = s i := by simp[vecConsLast]

@[simp] lemma rightConcat_zero (a : α) (s : Fin n.succ → α) :
    (s <: a) 0 = s 0 := rightConcat_castSucc 0

@[simp] lemma zero_succ_eq_id {n} : (0 : Fin (n + 1)) :> succ = id :=
  funext $ Fin.cases (by simp) (by simp)

lemma to_vecCons (s : Fin (n + 1) → C) : s = s 0 :> s ∘ Fin.succ :=
   funext $ Fin.cases (by simp) (by simp)

@[simp] lemma vecCons_ext (a₁ a₂ : α) (s₁ s₂ : Fin n → α) :
    a₁ :> s₁ = a₂ :> s₂ ↔ a₁ = a₂ ∧ s₁ = s₂ :=
  ⟨by intros h
      constructor
      · exact congrFun h 0
      · exact funext (fun i => by simpa using congrFun h (Fin.castSucc i + 1)),
   by intros h; simp[h]⟩

def decVec {α : Type _} : {n : ℕ} → (v w : Fin n → α) → (∀ i, Decidable (v i = w i)) → Decidable (v = w)
  | 0,     _, _, _ => by simp; exact isTrue trivial
  | n + 1, v, w, d => by
      rw[to_vecCons v, to_vecCons w, vecCons_ext]
      haveI : Decidable (v ∘ Fin.succ = w ∘ Fin.succ) := decVec _ _ (by intros i; simp; exact d _)
      refine instDecidableAnd

lemma comp_vecCons (f : α → β) (a : α) (s : Fin n → α) : (fun x => f $ (a :> s) x) = f a :> f ∘ s :=
funext (fun i => cases (by simp) (by simp) i)

lemma comp_vecCons' (f : α → β) (a : α) (s : Fin n → α) : (fun x => f $ (a :> s) x) = f a :> fun i => f (s i) :=
  comp_vecCons f a s

lemma comp_vecConsLast (f : α → β) (a : α) (s : Fin n → α) : (fun x => f $ (s <: a) x) = f ∘ s <: f a :=
funext (fun i => lastCases (by simp) (by simp) i)

@[simp] lemma vecHead_comp (f : α → β) (v : Fin (n + 1) → α) : vecHead (f ∘ v) = f (vecHead v) :=
  by simp[vecHead]

@[simp] lemma vecTail_comp (f : α → β) (v : Fin (n + 1) → α) : vecTail (f ∘ v) = f ∘ (vecTail v) :=
  by simp[vecTail, Function.comp.assoc]

lemma vecConsLast_vecEmpty {s : Fin 0 → α} (a : α) : s <: a = ![a] :=
  funext (fun x => by
    have : 0 = Fin.last 0 := by rfl
    cases' x using Fin.cases with i <;> simp[this]
    have := i.isLt; contradiction )

lemma constant_eq_singleton {a : α} : (fun _ => a) = ![a] := by funext x; simp

lemma injective_vecCons {f : Fin n → α} (h : Function.Injective f) {a} (ha : ∀ i, a ≠ f i) : Function.Injective (a :> f) := by
  have : ∀ i, f i ≠ a := fun i => (ha i).symm
  intro i j; cases i using Fin.cases <;> cases j using Fin.cases <;> simp[*]
  intro hf; exact h hf

section And

variable [HasLogicSymbols α]

def conj : {n : ℕ} → (Fin n → α) → α
  | 0,     _ => ⊤
  | _ + 1, v => v 0 ⋏ conj (vecTail v)

@[simp] lemma conj_nil (v : Fin 0 → α) : conj v = ⊤ := rfl

@[simp] lemma conj_cons {a : α} {v : Fin n → α} : conj (a :> v) = a ⋏ conj v := rfl

@[simp] lemma conj_hom (f : α →L Prop) (v : Fin n → α) : f (conj v) = ∀ i, f (v i) := by
  induction' n with n ih <;> simp[conj]
  · intro ⟨_, _⟩; contradiction
  · simp[ih]; constructor
    · intro ⟨hz, hs⟩ i; cases i using Fin.cases; { exact hz }; { exact hs _ }
    · intro h; exact ⟨h 0, fun i => h _⟩

end And

end

variable {α : Type _}

def toList : {n : ℕ} → (Fin n → α) → List α
  | 0,     _ => []
  | _ + 1, v => v 0 :: toList (v ∘ Fin.succ)

@[simp] lemma toList_zero (v : Fin 0 → α) : toList v = [] := rfl

@[simp] lemma toList_succ (v : Fin (n + 1) → α) : toList v = v 0 :: toList (v ∘ Fin.succ) := rfl

@[simp] lemma toList_length (v : Fin n → α) : (toList v).length = n :=
  by induction n <;> simp[*]

@[simp] lemma toList_nth (v : Fin n → α) (i) (hi) : (toList v).nthLe i hi = v ⟨i, by simpa using hi⟩ := by
  induction n generalizing i <;> simp[*, List.nthLe_cons]
  case zero => contradiction
  case succ => rcases i <;> simp

@[simp] lemma mem_toList_iff {v : Fin n → α} {a} : a ∈ toList v ↔ ∃ i, v i = a :=
  by induction n <;> simp[*]; constructor; { rintro (rfl | ⟨i, rfl⟩) <;> simp }; { rintro ⟨i, rfl⟩; cases i using Fin.cases <;> simp }

def toOptionVec : {n : ℕ} → (Fin n → Option α) → Option (Fin n → α)
  | 0,     _ => some vecEmpty
  | _ + 1, v => (toOptionVec (v ∘ Fin.succ)).bind (fun vs => (v 0).map (fun z => z :> vs))

@[simp] lemma toOptionVec_some (v : Fin n → α) :
    toOptionVec (fun i => some (v i)) = some v :=
  by induction n <;> simp[*, toOptionVec, Function.comp]; exact funext (Fin.cases (by simp) (by simp))

def vecToNat : {n : ℕ} → (Fin n → ℕ) → ℕ
  | 0,     _ => 0
  | _ + 1, v => Nat.mkpair (v 0) (vecToNat $ v ∘ Fin.succ)

end Matrix

def Nat.unvector : {n : ℕ} → ℕ → Fin n → ℕ
  | 0,     _ => Matrix.vecEmpty
  | _ + 1, e => e.unpair.1 :> Nat.unvector e.unpair.2

namespace Nat
open Matrix
variable {n}

@[simp] lemma unvector_le (e : ℕ) (i : Fin n) : unvector e i ≤ e := by
  induction' n with n ih generalizing e <;> simp[*, unvector]
  · have := i.isLt; contradiction
  · exact Fin.cases (by simpa using Nat.unpair_left_le _) (fun i => le_trans (ih e.unpair.2 i) (Nat.unpair_right_le _)) i

@[simp] lemma unvector_vecToNat (v : Fin n → ℕ) : unvector (vecToNat v) = v := by
  induction n <;> simp[*, Nat.unvector, vecToNat]; exact funext (fun i => i.cases (by simp) (by simp))

-- @[simp] lemma toNat_unvector (ln : 0 < n) (e : ℕ) : Fin.vecToNat (unvector e : Fin n → ℕ) = e := by
--   induction n generalizing e <;> simp[unvector, Fin.vecToNat, Function.comp]
--   · simp at ln
--   · {simp[Function.comp]; sorry}

lemma one_le_of_bodd {n : ℕ} (h : n.bodd = true) : 1 ≤ n :=
by induction n <;> simp[←Nat.add_one] at h ⊢

end Nat

namespace Fintype
variable {ι : Type _} [Fintype ι] {α : Type _} [SemilatticeSup α] [OrderBot α]

def sup (f : ι → α) : α := (Finset.univ : Finset ι).sup f

@[simp] lemma elem_le_sup (f : ι → α) (i : ι) : f i ≤ sup f := Finset.le_sup (by simp)

lemma le_sup {a : α} {f : ι → α} (i : ι) (le : a ≤ f i) : a ≤ sup f := le_trans le (elem_le_sup _ _)

@[simp] lemma sup_le_iff {f : ι → α} {a : α} :
    sup f ≤ a ↔ (∀ i, f i ≤ a) := by simp[sup]

@[simp] lemma finsup_eq_0_of_empty [IsEmpty ι] (f : ι → α) : sup f = ⊥ := by simp[sup]

end Fintype

namespace String

def vecToStr : ∀ {n}, (Fin n → String) → String
  | 0,     _ => ""
  | n + 1, s => if n = 0 then s 0 else s 0 ++ ", " ++ @vecToStr n (fun i => s (Fin.succ i))

#eval vecToStr !["a", "b", "c", "d"]

end String

namespace Empty

lemma eq_elim {α : Sort u} (f : Empty → α) : f = elim := funext (by rintro ⟨⟩)

end Empty

namespace Set
variable  {α : Type u} {β : Type v}

lemma subset_image_iff (f : α → β) {s : Set α} {t : Set β} :
    t ⊆ f '' s ↔ ∃ u, u ⊆ s ∧ f '' u = t :=
  ⟨by intro h
      use {a : α | a ∈ s ∧ f a ∈ t}
      constructor
      { intros a ha; exact ha.1 }
      { ext b; constructor <;> simp; { rintro a _ hfa rfl; exact hfa };
        { intros hb; rcases h hb with ⟨a, ha, rfl⟩; exact ⟨a, ⟨ha, hb⟩, rfl⟩ } },
   by { rintro ⟨u, hu, rfl⟩; intros b; simp; rintro a ha rfl; exact ⟨a, hu ha, rfl⟩ }⟩

end Set

namespace Function

variable  {α : Type u} {β : Type v}

def funEqOn (p : α → Prop) (f g : α → β) : Prop := ∀ a, p a → f a = g a

lemma funEqOn.of_subset {p q : α → Prop} {f g : α → β} (e : funEqOn p f g) (h : ∀ a, q a → p a) : funEqOn q f g :=
  by intro a ha; exact e a (h a ha)

end Function

namespace Quotient
open Matrix
variable {α : Type u} [s : Setoid α] {β : Sort v}

@[elab_as_elim]
lemma inductionOnVec {p : (Fin n → Quotient s) → Prop} (v : Fin n → Quotient s)
  (h : ∀ v : Fin n → α, p (fun i => Quotient.mk s (v i))) : p v :=
  Quotient.induction_on_pi v h

def liftVec : ∀ {n} (f : (Fin n → α) → β),
  (∀ v₁ v₂ : Fin n → α, (∀ n, v₁ n ≈ v₂ n) → f v₁ = f v₂) → (Fin n → Quotient s) → β
| 0,     f, _, _ => f ![]
| n + 1, f, h, v =>
  let ih : α → (Fin n → Quotient s) → β :=
    fun a v => liftVec (n := n) (fun v => f (a :> v))
      (fun v₁ v₂ hv => h (a :> v₁) (a :> v₂) (Fin.cases (by simp; exact refl a) hv)) v
  Quot.liftOn (vecHead v) (ih · (vecTail v))
  (fun a b hab => by
    have : ∀ v, f (a :> v) = f (b :> v) := fun v => h _ _ (Fin.cases hab (by simp; intro; exact refl _))
    simp[this])

@[simp] lemma liftVec_zero (f : (Fin 0 → α) → β) (h) (v : Fin 0 → Quotient s) : liftVec f h v = f ![] := rfl

lemma liftVec_mk {n} (f : (Fin n → α) → β) (h) (v : Fin n → α) :
    liftVec f h (Quotient.mk s ∘ v) = f v := by
  induction' n with n ih <;> simp[liftVec, empty_eq, Quotient.liftOn_mk]
  simpa using ih (fun v' => f (vecHead v :> v'))
    (fun v₁ v₂ hv => h (vecHead v :> v₁) (vecHead v :> v₂) (Fin.cases (refl _) hv)) (vecTail v)

@[simp] lemma liftVec_mk₁ (f : (Fin 1 → α) → β) (h) (a : α) :
    liftVec f h ![Quotient.mk s a] = f ![a] := liftVec_mk f h ![a]

@[simp] lemma liftVec_mk₂ (f : (Fin 2 → α) → β) (h) (a₁ a₂ : α) :
    liftVec f h ![Quotient.mk s a₁, Quotient.mk s a₂] = f ![a₁, a₂] := liftVec_mk f h ![a₁, a₂]

end Quotient

class Class (F : Type u → Type v) (α : Type u) where
  out : F α

namespace Class
variable {F : Type u → Type v} {α : Type u}

@[simp] lemma out_mk (x : F α) : out (self := Class.mk x) = x := rfl

@[simp] lemma mk_out [x : Class F α] : Class.mk out = x := rfl

end Class


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import logic.equiv.list

/-!
# W types

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

Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the
inductively defined type of trees where the nodes are labeled by elements of `α` and the children of
a node labeled `a` are indexed by elements of `β a`.

This file is currently a stub, awaiting a full development of the theory. Currently, the main result
is that if `α` is an encodable fintype and `β a` is encodable for every `a : α`, then `W_type β` is
encodable. This can be used to show the encodability of other inductive types, such as those that
are commonly used to formalize syntax, e.g. terms and expressions in a given language. The strategy
is illustrated in the example found in the file `prop_encodable` in the `archive/examples` folder of
mathlib.

## Implementation details

While the name `W_type` is somewhat verbose, it is preferable to putting a single character
identifier `W` in the root namespace.
-/

/--
Given `β : α → Type*`, `W_type β` is the type of finitely branching trees where nodes are labeled by
elements of `α` and the children of a node labeled `a` are indexed by elements of `β a`.
-/
inductive W_type {α : Type*} (β : α → Type*)
| mk (a : α) (f : β a → W_type) : W_type

instance : inhabited (W_type (λ (_ : unit), empty)) :=
⟨W_type.mk unit.star empty.elim⟩

namespace W_type

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

/-- The canonical map to the corresponding sigma type, returning the label of a node as an
  element `a` of `α`, and the children of the node as a function `β a → W_type β`. -/
def to_sigma : W_type β → Σ a : α, β a → W_type β
| ⟨a, f⟩ := ⟨a, f⟩

/-- The canonical map from the sigma type into a `W_type`. Given a node `a : α`, and
  its children as a function `β a → W_type β`, return the corresponding tree. -/
def of_sigma : (Σ a : α, β a → W_type β) → W_type β
| ⟨a, f⟩ := W_type.mk a f

@[simp] lemma of_sigma_to_sigma : Π (w : W_type β),
  of_sigma (to_sigma w) = w
| ⟨a, f⟩ := rfl

@[simp] lemma to_sigma_of_sigma : Π (s : Σ a : α, β a → W_type β),
  to_sigma (of_sigma s) = s
| ⟨a, f⟩ := rfl

variable (β)

/-- The canonical bijection with the sigma type, showing that `W_type` is a fixed point of
  the polynomial functor `X ↦ Σ a : α, β a → X`. -/
@[simps] def equiv_sigma : W_type β ≃ Σ a : α, β a → W_type β :=
{ to_fun := to_sigma,
  inv_fun := of_sigma,
  left_inv := of_sigma_to_sigma,
  right_inv := to_sigma_of_sigma }

variable {β}

/-- The canonical map from `W_type β` into any type `γ` given a map `(Σ a : α, β a → γ) → γ`. -/
def elim (γ : Type*) (fγ : (Σ a : α, β a → γ) → γ) : W_type β → γ
| ⟨a, f⟩ := fγ ⟨a, λ b, elim (f b)⟩

lemma elim_injective (γ : Type*) (fγ : (Σ a : α, β a → γ) → γ)
  (fγ_injective : function.injective fγ) :
  function.injective (elim γ fγ)
| ⟨a₁, f₁⟩ ⟨a₂, f₂⟩ h := begin
  obtain ⟨rfl, h⟩ := sigma.mk.inj (fγ_injective h),
  congr' with x,
  exact elim_injective (congr_fun (eq_of_heq h) x : _),
end

instance [hα : is_empty α] : is_empty (W_type β) :=
⟨λ w, W_type.rec_on w (is_empty.elim hα)⟩

lemma infinite_of_nonempty_of_is_empty (a b : α) [ha : nonempty (β a)]
  [he : is_empty (β b)] : infinite (W_type β) :=
⟨begin
  introsI hf,
  have hba : b ≠ a, from λ h, ha.elim (is_empty.elim' (show is_empty (β a), from h ▸ he)),
  refine not_injective_infinite_finite
    (λ n : ℕ, show W_type β, from nat.rec_on n
      ⟨b, is_empty.elim' he⟩
      (λ n ih, ⟨a, λ _, ih⟩)) _,
  intros n m h,
  induction n with n ih generalizing m h,
  { cases m with m; simp * at * },
  { cases m with m,
    { simp * at * },
    { refine congr_arg nat.succ (ih _),
      simp [function.funext_iff, *] at * } }
end⟩

variables [Π a : α, fintype (β a)]

/-- The depth of a finitely branching tree. -/
def depth : W_type β → ℕ
| ⟨a, f⟩ := finset.sup finset.univ (λ n, depth (f n)) + 1

lemma depth_pos (t : W_type β) : 0 < t.depth :=
by { cases t, apply nat.succ_pos }

lemma depth_lt_depth_mk (a : α) (f : β a → W_type β) (i : β a) :
  depth (f i) < depth ⟨a, f⟩ :=
nat.lt_succ_of_le (finset.le_sup (finset.mem_univ i))

/-
Show that W types are encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable.

We define an auxiliary type `W_type' β n` of trees of depth at most `n`, and then we show by
induction on `n` that these are all encodable. These auxiliary constructions are not interesting in
and of themselves, so we mark them as `private`.
-/

@[reducible] private def W_type' {α : Type*} (β : α → Type*)
    [Π a : α, fintype (β a)] [Π a : α, encodable (β a)] (n : ℕ) :=
{ t : W_type β // t.depth ≤ n}

variables [Π a : α, encodable (β a)]

private def encodable_zero : encodable (W_type' β 0) :=
let f    : W_type' β 0 → empty := λ ⟨x, h⟩, false.elim $ not_lt_of_ge h (W_type.depth_pos _),
    finv : empty → W_type' β 0 := by { intro x, cases x} in
have ∀ x, finv (f x) = x, from λ ⟨x, h⟩, false.elim $ not_lt_of_ge h (W_type.depth_pos _),
encodable.of_left_inverse f finv this

private def f (n : ℕ) : W_type' β (n + 1) → Σ a : α, β a → W_type' β n
| ⟨t, h⟩ :=
  begin
    cases t with a f,
    have h₀ : ∀ i : β a, W_type.depth (f i) ≤ n,
      from λ i, nat.le_of_lt_succ (lt_of_lt_of_le (W_type.depth_lt_depth_mk a f i) h),
    exact ⟨a, λ i : β a, ⟨f i, h₀ i⟩⟩
  end

private def finv (n : ℕ) :
  (Σ a : α, β a → W_type' β n) → W_type' β (n + 1)
| ⟨a, f⟩ :=
  let f' := λ i : β a, (f i).val in
  have W_type.depth ⟨a, f'⟩ ≤ n + 1,
    from add_le_add_right (finset.sup_le (λ b h, (f b).2)) 1,
  ⟨⟨a, f'⟩, this⟩

variables [encodable α]

private def encodable_succ (n : nat) (h : encodable (W_type' β n)) :
  encodable (W_type' β (n + 1)) :=
encodable.of_left_inverse (f n) (finv n) (by { rintro ⟨⟨_, _⟩, _⟩, refl })

/-- `W_type` is encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable. -/
instance : encodable (W_type β) :=
begin
  haveI h' : Π n, encodable (W_type' β n) :=
    λ n, nat.rec_on n encodable_zero encodable_succ,
  let f    : W_type β → Σ n, W_type' β n   := λ t, ⟨t.depth, ⟨t, le_rfl⟩⟩,
  let finv : (Σ n, W_type' β n) → W_type β := λ p, p.2.1,
  have : ∀ t, finv (f t) = t, from λ t, rfl,
  exact encodable.of_left_inverse f finv this
end

end W_type


import topology.instances.real

open filter real
open_locale topological_space

theorem problem_2 (X : Type*) [topological_space X] (a : ℕ → X) (l₁ l₂ : X)
  (h₁ : tendsto a at_top (𝓝 l₁)) (h₂ : tendsto a at_top (𝓝 l₂)) :
  l₁ = l₂ :=
begin
  sorry
end


lemma succ_add (a b : mynat) : succ a + b = succ (a + b) :=
begin
induction b with k Pk,
rw add_zero, rw add_zero, refl,
rw add_succ, rw add_succ, rw Pk, refl,
end


import tactic
import data.int.parity
import data.int.modeq
import data.nat.factorization.basic
import number_theory.legendre_symbol.quadratic_reciprocity

import Mordell.CongruencesMod4

lemma neg_one_square (p : ℤ) (hp : prime p) (h : ∃ (n : ℤ), n^2 ≡ -1 [ZMOD p]) : p ≡ 3 [ZMOD 4] :=
begin
--this is maybe somewhere in mathlib
sorry,
end

lemma neg_two_square_mod_p (p : ℤ) (hp : prime p) (h : ∃ (n : ℤ), n^2 ≡ -2 [ZMOD p]) :
  (p ≡ 1 [ZMOD 8] ∨ p ≡ 3  [ZMOD 8]) :=
begin
--this is maybe somewhere in mathlib
sorry,
end

example (x y : ℤ) : y^2 ≠ x^3 - 24 :=
begin
sorry,

end


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

import Aesop

set_option aesop.check.all true

inductive Even : Nat → Prop
| zero : Even 0
| plus_two {n} : Even n → Even (n + 2)

inductive Odd : Nat → Prop
| one : Odd 1
| plus_two {n} : Odd n → Odd (n + 2)

inductive EvenOrOdd : Nat → Prop
| even {n} : Even n → EvenOrOdd n
| odd {n} : Odd n → EvenOrOdd n

-- We can add constants as rules.
example : EvenOrOdd 3 := by
  aesop
    (add safe [Even.zero, Even.plus_two, Odd.one, Odd.plus_two],
         unsafe [apply 50% EvenOrOdd.even, 50% EvenOrOdd.odd])

-- Same with local hypotheses, or a mix.
example : EvenOrOdd 3 := by
  have h : ∀ n, Odd n → EvenOrOdd n := λ _ p => EvenOrOdd.odd p
  aesop
    (add safe [Odd.one, Odd.plus_two], unsafe [EvenOrOdd.even 50%, h 50%])
    (erase Aesop.BuiltinRules.applyHyps) -- This rule subsumes h.

attribute [aesop 50%] Even.zero Even.plus_two

-- We can also erase global rules...
example : EvenOrOdd 2 := by
  fail_if_success aesop (add safe EvenOrOdd.even) (erase Even.zero)
    (options := { terminal := true })
  aesop (add safe EvenOrOdd.even)

-- ... as well as local ones (but what for?).
example : EvenOrOdd 2 := by
  have h : ∀ n, Even n → EvenOrOdd n := λ _ p => EvenOrOdd.even p
  fail_if_success
    aesop (add safe h) (erase Aesop.BuiltinRules.applyHyps, h)
      (options := { terminal := true })
  aesop (add safe h) (erase Aesop.BuiltinRules.applyHyps)


import group.basic group.powers finsum.basic

/-!

Basic definitions for subgroups in group theory.
Not for the mathematician beginner.

-/

-- We're always overwriting group theory here so we always work in
-- a namespace
namespace mygroup

open mygroup.group

/- subgroups (bundled) -/

/-- A subgroup of a group G is a subset containing 1
and closed under multiplication and inverse. -/
structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

-- Defintion of normal subgroup (in a bundled form)
structure normal (G : Type) [group G] extends subgroup G :=
(conj_mem' : ∀ n, n ∈ carrier → ∀ g : G, g * n * g⁻¹ ∈ carrier)

-- we put dashes in all the names, because we'll define
-- non-dashed versions which don't mention `carrier` at all
-- and just talk about elements of the subgroup.

namespace subgroup

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

-- Instead let's define ∈ directly
instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

-- subgroups form a lattice and we might want to prove this
-- later on?
instance : has_le (subgroup G) := ⟨λ S T, S.carrier ⊆ T.carrier⟩

/-- Two subgroups are equal if the underlying subsets are equal. -/
theorem ext' {H K : subgroup G} (h : H.carrier = K.carrier) : H = K :=
by cases H; cases K; congr'

/-- Two subgroups are equal if they have the same elements. -/
theorem ext {H K : subgroup G}
  (h : ∀ x, x ∈ H ↔ x ∈ K) : H = K := ext' $ set.ext h

lemma mem_coe {g : G} : g ∈ H.carrier ↔ g ∈ H := iff.rfl

/-- Two subgroups are equal if and only if the underlying subsets are equal. -/
protected theorem ext'_iff {H K : subgroup G} :
  H.carrier = K.carrier ↔ H = K :=
⟨ext', λ h, h ▸ rfl⟩

attribute [ext] subgroup.ext

/-- A subgroup contains the group's 1. -/
theorem one_mem : (1 : G) ∈ H := H.one_mem'

/-- A subgroup is closed under multiplication. -/
theorem mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H := subgroup.mul_mem' _

/-- A subgroup is closed under inverse -/
theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H := subgroup.inv_mem' _

/-- A subgroup is closed under integer powers -/
theorem pow_mem {x : G} {n : ℤ} : x ∈ H → x ^ n ∈ H :=
begin
  intro hx,
  apply int.induction_on n,
    { rw group.pow_zero, exact H.one_mem },
    { intros i hi,
      convert H.mul_mem hi hx,
      rw [group.pow_add, group.pow_one] },
    { intros i hi,
      convert H.mul_mem hi (H.inv_mem hx),
      rw [← group.pow_neg_one_inv, ← group.pow_add ], congr' }
end

@[simp] theorem inv_mem_iff {x :G} : x⁻¹ ∈ H ↔ x ∈ H :=
  ⟨ λ hx, group.inv_inv x ▸ H.inv_mem hx, H.inv_mem ⟩

-- Coersion to group
-- Coercion from subgroup to underlying type

instance : has_coe (subgroup G) (set G) := ⟨subgroup.carrier⟩

lemma mem_coe' {g : G} : g ∈ (H : set G) ↔ g ∈ H := iff.rfl

instance of_subgroup (K : subgroup G) : group ↥K :=
{ mul := λ a b, ⟨a.1 * b.1, K.mul_mem' a.2 b.2⟩,
  one := ⟨1, K.one_mem'⟩,
  inv := λ a, ⟨a⁻¹, K.inv_mem' a.2⟩,
  mul_assoc := λ a b c, by { cases a, cases b, cases c, refine subtype.ext _,
    apply group.mul_assoc },
  one_mul := λ a, by { cases a, apply subtype.ext, apply group.one_mul },
  mul_left_inv := λ a, by { cases a, apply subtype.ext,
    apply group.mul_left_inv } }

/-- Returns index of a subgroup in a group -/
noncomputable def index (H : subgroup G) : ℕ := fincard G / fincard H

/-- `index' H J` returns the index of J in H -/
noncomputable def index'(H : subgroup G) (J : subgroup G): ℕ := fincard H / fincard J

-- Defining cosets thats used in some lemmas
def lcoset (g : G) (K : subgroup G) := {s : G | ∃ k ∈ K, s = g * k}
def rcoset (g : G) (K : subgroup G) := {s : G | ∃ k ∈ K, s = k * g}
notation g ` ⋆ ` :70 H :70 := lcoset g H
notation H ` ⋆ ` :70 g :70 := rcoset g H

attribute [reducible] lcoset rcoset

@[simp] lemma coe_mul (a b : G) (ha : a ∈ H) (hb : b ∈ H) :
  ((⟨a, ha⟩ * ⟨b, hb⟩ : H) : G) = a * b := rfl

end subgroup

namespace normal

variables {G : Type} [group G]

instance : has_coe (normal G) (subgroup G) :=
  ⟨λ K, K.to_subgroup⟩

-- This saves me from writting m ∈ (K : subgroup G) every time
instance : has_mem G (normal G) := ⟨λ m K, m ∈ K.carrier⟩

instance to_set : has_coe (normal G) (set G) := ⟨λ K, K.carrier⟩

@[simp] lemma mem_to_subgroup {K : normal G} (x : G) :
  x ∈ K.to_subgroup ↔ x ∈ K := iff.rfl

@[simp] lemma mem_carrier {K : normal G} (x : G) :
  x ∈ K.carrier ↔ x ∈ K := iff.rfl

lemma conj_mem  (N : normal G) (n : G) (hn : n ∈ N) (g : G) :
  g * n * g⁻¹ ∈ N := N.conj_mem' n hn g

@[ext] lemma ext (A B : normal G) (h : ∀ g, g ∈ A ↔ g ∈ B) : A = B :=
begin
  cases A with A, cases B with B, cases A with A, cases B with B,
  suffices : A = B,
    simp * at *,
  ext x, exact h x
end

theorem ext' {H K : normal G} (h : H.to_subgroup = K.to_subgroup) : H = K :=
by cases H; cases K; congr'

instance of_normal (N : normal G) : group ↥N :=
  subgroup.of_subgroup (N : subgroup G)

def of_subgroup (H : subgroup G)
  (hH : ∀ n, n ∈ H → ∀ g : G, g * n * g⁻¹ ∈ H) : normal G :=
{ conj_mem' := hH, .. H }

def of_comm_subgroup {G : Type} [comm_group G] (H : subgroup G) :
  normal G :=
{ conj_mem' := λ _ _ _, by simpa [group.mul_comm, group.mul_assoc], .. H}

end normal

/-
An API for subgroups

Mathematician-friendly

Let G be a group. The type of subgroups of G is `subgroup G`.
In other words, if `H : subgroup G` then H is a subgroup of G.
The three basic facts you need to know about H are:

H.one_mem : (1 : G) ∈ H
H.mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H
H.inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H

-/

variables {G : Type} [group G]

namespace lagrange

variables {H : subgroup G}

lemma self_mem_coset (a : G) (H : subgroup G): a ∈ a ⋆ H :=
  ⟨1, H.one_mem, (group.mul_one a).symm⟩

/-- Two cosets `a ⋆ H`, `b ⋆ H` are equal if and only if `b⁻¹ * a ∈ H` -/
theorem lcoset_eq {a b : G} :
  a ⋆ H = b ⋆ H ↔ b⁻¹ * a ∈ H :=
begin
  split; intro h,
    { replace h : a ∈ b ⋆ H, rw ←h, exact self_mem_coset a H,
      rcases h with ⟨g, hg₀, hg₁⟩,
      rw hg₁, simp [←group.mul_assoc, hg₀] },
    { ext, split; intro hx,
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          exact ⟨b⁻¹ * a * g, H.mul_mem h hg₀, by simp [←group.mul_assoc]⟩ },
        { rcases hx with ⟨g, hg₀, hg₁⟩, rw hg₁,
          refine ⟨a⁻¹ * b * g, H.mul_mem _ hg₀, by simp [←group.mul_assoc]⟩,
          convert H.inv_mem h, simp } }
end

-- A corollary of this is a ⋆ H = H iff a ∈ H

/-- The coset of `H`, `1 ⋆ H` equals `H` -/
theorem lcoset_of_one : 1 ⋆ H = H :=
begin
  ext, split; intro hx,
    { rcases hx with ⟨h, hh₀, hh₁⟩,
      rwa [hh₁, group.one_mul] },
    { exact ⟨x, hx, (group.one_mul x).symm⟩ }
end

/-- A left coset `a ⋆ H` equals `H` if and only if `a ∈ H` -/
theorem lcoset_of_mem {a : G} :
  a ⋆ H = H ↔ a ∈ H := by rw [←lcoset_of_one, lcoset_eq]; simp

/-- Two left cosets `a ⋆ H` and `b ⋆ H` are equal if they are not disjoint -/
theorem lcoset_digj {a b c : G} (ha : c ∈ a ⋆ H) (hb : c ∈ b ⋆ H) :
  a ⋆ H = b ⋆ H :=
begin
  rcases ha with ⟨g₀, hg₀, hca⟩,
  rcases hb with ⟨g₁, hg₁, hcb⟩,
  rw lcoset_eq, rw (show a = c * g₀⁻¹, by simp [hca, group.mul_assoc]),
  rw (show b⁻¹ = g₁ * c⁻¹,
    by rw (show b = c * g₁⁻¹, by simp [hcb, group.mul_assoc]); simp),
  suffices : g₁ * g₀⁻¹ ∈ H,
    { rw [group.mul_assoc, ←@group.mul_assoc _ _ c⁻¹],
      simp [this] },
  exact H.mul_mem hg₁ (H.inv_mem hg₀)
end

-- Now we would like to prove that all lcosets have the same order

open function

private def aux_map (a : G) (H : subgroup G) : H → a ⋆ H :=
  λ h, ⟨a * h, h, h.2, rfl⟩

private lemma aux_map_biject {a : G} : bijective $ aux_map a H :=
begin
  split,
    { intros x y hxy,
      suffices : (x : G) = y,
        { ext, assumption },
        { simp [aux_map] at hxy, assumption } },
    { rintro ⟨y, y_prop⟩,
      rcases y_prop with ⟨h, hh₀, hh₁⟩,
      refine ⟨⟨h, hh₀⟩, by simp [aux_map, hh₁]⟩ }
end

/-- There is a bijection between `H` and its left cosets -/
noncomputable theorem lcoset_equiv {a : G} : H ≃ a ⋆ H :=
equiv.of_bijective (aux_map a H) aux_map_biject

-- We are going to use fincard which maps a fintype to its fintype.card
-- and maps to 0 otherwise

/-- The cardinality of `H` equals its left cosets-/
lemma eq_card_of_lcoset {a : G} : fincard H = fincard (a ⋆ H) :=
  fincard.of_equiv lcoset_equiv

/-- The cardinality of all left cosets are equal -/
theorem card_of_lcoset_eq {a b : G} :
  fincard (a ⋆ H) = fincard (b ⋆ H) := by iterate 2 { rw ←eq_card_of_lcoset }

-- The rest of the proof will requires quotient

end lagrange

namespace normal

lemma mem_normal {x} {N : normal G} :
  x ∈ N ↔ ∃ (g : G) (n ∈ N), x = g * n * g⁻¹ :=
begin
  split; intro h,
    { exact ⟨1, x, h, by simp⟩ },
    { rcases h with ⟨g, n, hn, rfl⟩,
      exact conj_mem _ _ hn _ }
end

lemma mem_normal' {x} {N : normal G} :
  x ∈ N ↔ ∃ (g : G) (n ∈ N), x = g⁻¹ * n * g :=
begin
  rw mem_normal,
  split; rintro ⟨g, n, hn, rfl⟩;
    { exact ⟨g⁻¹, n, hn, by simp⟩ }
end

-- Any two elements commute regarding the normal subgroup membership relation
lemma comm_mem_of_normal {K : normal G}
  {g k : G} (h : g * k ∈ K) : k * g ∈ K :=
begin
  suffices : k * (g * k) * k⁻¹ ∈ K,
    { simp [group.mul_assoc] at this, assumption },
  refine normal.conj_mem _ _ h _
end

def normal_of_mem_comm {K : subgroup G}
  (h : ∀ g k : G, g * k ∈ K → k * g ∈ K) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    suffices : g * (n * g⁻¹) ∈ K,
      { rwa ←group.mul_assoc at this },
    refine h _ _ _, simpa [group.mul_assoc]
  end, .. K } -- The .. tells Lean that we use K for the unfilled fields

-- If K is a normal subgroup of the group G, then the sets of left and right
-- cosets of K in the G coincide
lemma nomal_coset_eq {K : normal G} :
  ∀ g : G, g ⋆ (K : subgroup G) = (K : subgroup G) ⋆ g :=
begin
  -- dsimp,
  -- Without the dsimp it displays weridly,
  -- dsimp not required if we write out right_coset g K however?
  intros g,
  ext, split; intro hx,
    { rcases hx with ⟨k, hk, rfl⟩,
      refine ⟨_, K.2 k hk g, _⟩,
      simp [group.mul_assoc] },
    { rcases hx with ⟨k, hk, rfl⟩,
      refine ⟨_, K.2 k hk g⁻¹, _⟩,
      simp [←group.mul_assoc] }
end

def normal_of_coset_eq {K : subgroup G}
  (h : ∀ g : G, g ⋆ K = K ⋆ g) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    have : ∃ s ∈ K ⋆ g, s = g * n,
      { refine ⟨g * n, _, rfl⟩,
        rw ←h, exact ⟨n, hn, rfl⟩ },
    rcases this with ⟨s, ⟨l, hl₁, hl₂⟩, hs₂⟩,
    rw [←hs₂, hl₂],
    simpa [group.mul_assoc]
  end, .. K}

-- If K is normal then if x ∈ g K and y ∈ h K then x * y ∈ (g * h) K
lemma prod_in_coset_of_normal {K : normal G} {x y g h : G}
  (hx : x ∈ g ⋆ K) (hy : y ∈ h ⋆ K) : x * y ∈ (g * h) ⋆ K :=
begin
  rcases hx with ⟨k₀, hx₁, rfl⟩,
  rcases hy with ⟨k₁, hy₁, rfl⟩,
  refine ⟨h⁻¹ * k₀ * h * k₁, _, _⟩,
    { refine K.1.3 _ hy₁,
      convert K.2 _ hx₁ _, exact (group.inv_inv _).symm },
    { iterate 2 { rw group.mul_assoc },
      rw group.mul_left_cancel_iff g _ _,
      simp [←group.mul_assoc] }
end

def normal_of_prod_in_coset {K : subgroup G}
  (h : ∀ x y g h : G, x ∈ g ⋆ K → y ∈ h ⋆ K → x * y ∈ (g * h) ⋆ K) : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    rcases h (g * n) (g⁻¹ * n) g g⁻¹
      ⟨n, hn, rfl⟩ ⟨n, hn, rfl⟩ with ⟨m, hm₀, hm₁⟩,
    rw [←group.mul_right_cancel_iff n⁻¹,
        group.mul_assoc, group.mul_assoc, group.mul_assoc] at hm₁,
    suffices : g * n * g⁻¹ = m * n⁻¹,
      rw this, exact K.mul_mem hm₀ (K.inv_mem hn),
    simp [←group.mul_assoc] at hm₁; assumption
  end, .. K }

end normal

end mygroup


import analysis.calculus.deriv
import algebra.group.pi
import analysis.normed_space.ordered

namespace asymptotics

open filter

open_locale topological_space

lemma is_o.tendsto_of_tendsto_const {α E 𝕜 : Type*} [normed_group E] [normed_field 𝕜] {u : α → E}
  {v : α → 𝕜} {l : filter α} {y : 𝕜} (huv : is_o u v l) (hv : tendsto v l (𝓝 y)) :
  tendsto u l (𝓝 0) :=
begin
  suffices h : is_o u (λ x, (1 : 𝕜)) l,
  { rwa is_o_one_iff at h },
  exact huv.trans_is_O (is_O_one_of_tendsto 𝕜 hv),
end

section normed_linear_ordered_group

variables {α β : Type*} [normed_linear_ordered_group β] {u v w : α → β} {l : filter α} {c : ℝ}

lemma is_O.trans_tendsto_norm_at_top (huv : is_O u v l)
  (hu : tendsto (λ x, ∥u x∥) l at_top) :
  tendsto (λ x, ∥v x∥) l at_top :=
begin
  rcases huv.exists_pos with ⟨c, hc, hcuv⟩,
  rw is_O_with at hcuv,
  convert tendsto_at_top_div hc (tendsto_at_top_mono' l hcuv hu),
  ext x,
  rw mul_div_cancel_left _ hc.ne.symm,
end

end normed_linear_ordered_group

end asymptotics


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

import ring_theory.integrally_closed
import ring_theory.localization.num_denom
import ring_theory.polynomial.scale_roots

/-!
# Rational root theorem and integral root theorem

This file contains the rational root theorem and integral root theorem.
The rational root theorem for a unique factorization domain `A`
with localization `S`, states that the roots of `p : A[X]` in `A`'s
field of fractions are of the form `x / y` with `x y : A`, `x ∣ p.coeff 0` and
`y ∣ p.leading_coeff`.
The corollary is the integral root theorem `is_integer_of_is_root_of_monic`:
if `p` is monic, its roots must be integers.
Finally, we use this to show unique factorization domains are integrally closed.

## References

 * https://en.wikipedia.org/wiki/Rational_root_theorem
-/

open_locale polynomial
section scale_roots

variables {A K R S : Type*} [comm_ring A] [field K] [comm_ring R] [comm_ring S]
variables {M : submonoid A} [algebra A S] [is_localization M S] [algebra A K] [is_fraction_ring A K]

open finsupp is_fraction_ring is_localization polynomial

lemma scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero {p : A[X]} {r : A} {s : M}
  (hr : aeval (mk' S r s) p = 0) :
  aeval (algebra_map A S r) (scale_roots p s) = 0 :=
begin
  convert scale_roots_eval₂_eq_zero (algebra_map A S) hr,
  rw [aeval_def, mk'_spec' _ r s]
end

variables [is_domain A]

lemma num_is_root_scale_roots_of_aeval_eq_zero
  [unique_factorization_monoid A] {p : A[X]} {x : K} (hr : aeval x p = 0) :
  is_root (scale_roots p (denom A x)) (num A x) :=
begin
  apply is_root_of_eval₂_map_eq_zero (is_fraction_ring.injective A K),
  refine scale_roots_aeval_eq_zero_of_aeval_mk'_eq_zero _,
  rw mk'_num_denom,
  exact hr
end

end scale_roots

section rational_root_theorem

variables {A K : Type*} [comm_ring A] [is_domain A] [unique_factorization_monoid A] [field K]
variables [algebra A K] [is_fraction_ring A K]

open is_fraction_ring is_localization polynomial unique_factorization_monoid

/-- Rational root theorem part 1:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the numerator of `r` divides the constant coefficient -/
theorem num_dvd_of_is_root {p : A[X]} {r : K} (hr : aeval r p = 0) :
  num A r ∣ p.coeff 0 :=
begin
  suffices : num A r ∣ (scale_roots p (denom A r)).coeff 0,
  { simp only [coeff_scale_roots, tsub_zero] at this,
    haveI := classical.prop_decidable,
    by_cases hr : num A r = 0,
    { obtain ⟨u, hu⟩ := (is_unit_denom_of_num_eq_zero hr).pow p.nat_degree,
      rw ←hu at this,
      exact units.dvd_mul_right.mp this },
    { refine dvd_of_dvd_mul_left_of_no_prime_factors hr _ this,
      intros q dvd_num dvd_denom_pow hq,
      apply hq.not_unit,
      exact num_denom_reduced A r dvd_num (hq.dvd_of_dvd_pow dvd_denom_pow) } },
  convert dvd_term_of_is_root_of_dvd_terms 0 (num_is_root_scale_roots_of_aeval_eq_zero hr) _,
  { rw [pow_zero, mul_one] },
  intros j hj,
  apply dvd_mul_of_dvd_right,
  convert pow_dvd_pow (num A r) (nat.succ_le_of_lt (bot_lt_iff_ne_bot.mpr hj)),
  exact (pow_one _).symm
end

/-- Rational root theorem part 2:
if `r : f.codomain` is a root of a polynomial over the ufd `A`,
then the denominator of `r` divides the leading coefficient -/
theorem denom_dvd_of_is_root {p : A[X]} {r : K} (hr : aeval r p = 0) :
  (denom A r : A) ∣ p.leading_coeff :=
begin
  suffices : (denom A r : A) ∣ p.leading_coeff * num A r ^ p.nat_degree,
  { refine dvd_of_dvd_mul_left_of_no_prime_factors
      (mem_non_zero_divisors_iff_ne_zero.mp (denom A r).2) _ this,
    intros q dvd_denom dvd_num_pow hq,
    apply hq.not_unit,
    exact num_denom_reduced A r (hq.dvd_of_dvd_pow dvd_num_pow) dvd_denom },
  rw ←coeff_scale_roots_nat_degree,
  apply dvd_term_of_is_root_of_dvd_terms _ (num_is_root_scale_roots_of_aeval_eq_zero hr),
  intros j hj,
  by_cases h : j < p.nat_degree,
  { rw coeff_scale_roots,
    refine (dvd_mul_of_dvd_right _ _).mul_right _,
    convert pow_dvd_pow _ (nat.succ_le_iff.mpr (lt_tsub_iff_left.mpr _)),
    { exact (pow_one _).symm },
    simpa using h },
  rw [←nat_degree_scale_roots p (denom A r)] at *,
  rw [coeff_eq_zero_of_nat_degree_lt (lt_of_le_of_ne (le_of_not_gt h) hj.symm), zero_mul],
  exact dvd_zero _
end

/-- Integral root theorem:
if `r : f.codomain` is a root of a monic polynomial over the ufd `A`,
then `r` is an integer -/
theorem is_integer_of_is_root_of_monic {p : A[X]} (hp : monic p) {r : K}
  (hr : aeval r p = 0) : is_integer A r :=
is_integer_of_is_unit_denom (is_unit_of_dvd_one _ (hp ▸ denom_dvd_of_is_root hr))

namespace unique_factorization_monoid

lemma integer_of_integral {x : K} :
  is_integral A x → is_integer A x :=
λ ⟨p, hp, hx⟩, is_integer_of_is_root_of_monic hp hx

@[priority 100] -- See library note [lower instance priority]
instance : is_integrally_closed A :=
⟨λ x, integer_of_integral⟩

end unique_factorization_monoid

end rational_root_theorem


def Wrapper (n : Nat) : Type × Type :=
  (Fin n, Fin n)

def some_property {n} (x : Fin n) : Prop :=
  True

example (x : (Wrapper n).1) (h : some_property x) : True := by
  unfold Wrapper at x
  trace_state
  simp at x
  trace_state
  sorry

example (x : (Wrapper n).1) (h : some_property x) : True := by
  simp [Wrapper] at x
  trace_state
  sorry