/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.basic
import Mathlib.data.equiv.encodable.basic
import Mathlib.PostPort

universes u_2 l u_1

namespace Mathlib

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.

- `ideal P`: the type of upward directed, downward closed subsets of `P`.
             Dual to the notion of a filter on a preorder.
- `cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
               Dual to the notion of 'dense set' used in forcing.
- `ideal_of_cofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of P: an ideal in `P` which contains `p` and intersects every set in `𝒟`.

## References

- https://en.wikipedia.org/wiki/Ideal_(order_theory)
- https://en.wikipedia.org/wiki/Cofinal_(mathematics)
- https://en.wikipedia.org/wiki/Rasiowa–Sikorski_lemma

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## Tags

ideal, cofinal, dense, countable, generic

-/

namespace order

/-- An ideal on a preorder `P` is a subset of `P` that is
  - nonempty
  - upward directed
  - downward closed. -/
structure ideal (P : Type u_2) [preorder P] where
  carrier : set P
  nonempty : set.nonempty carrier
  directed : directed_on LessEq carrier
  mem_of_le : ∀ {x y : P}, x ≤ y → y ∈ carrier → x ∈ carrier

namespace ideal

/-- The smallest ideal containing a given element. -/
def principal {P : Type u_1} [preorder P] (p : P) : ideal P :=
  mk (set_of fun (x : P) => x ≤ p) sorry sorry sorry

protected instance inhabited {P : Type u_1} [preorder P] [Inhabited P] : Inhabited (ideal P) :=
  { default := principal Inhabited.default }

/-- An ideal of `P` can be viewed as a subset of `P`. -/
protected instance set.has_coe {P : Type u_1} [preorder P] : has_coe (ideal P) (set P) :=
  has_coe.mk carrier

/-- For the notation `x ∈ I`. -/
protected instance has_mem {P : Type u_1} [preorder P] : has_mem P (ideal P) :=
  has_mem.mk fun (x : P) (I : ideal P) => x ∈ ↑I

/-- Two ideals are equal when their underlying sets are equal. -/
theorem ext {P : Type u_1} [preorder P] (I : ideal P) (J : ideal P) : ↑I = ↑J → I = J := sorry

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
protected instance partial_order {P : Type u_1} [preorder P] : partial_order (ideal P) :=
  partial_order.lift coe ext

theorem mem_of_mem_of_le {P : Type u_1} [preorder P] {x : P} {I : ideal P} {J : ideal P} :
    x ∈ I → I ≤ J → x ∈ J :=
  set.mem_of_mem_of_subset

@[simp] theorem principal_le_iff {P : Type u_1} [preorder P] {x : P} {I : ideal P} :
    principal x ≤ I ↔ x ∈ I :=
  { mp := fun (h : ∀ {y : P}, y ≤ x → y ∈ I) => h (le_refl x),
    mpr := fun (h_mem : x ∈ I) (y : P) (h_le : y ≤ x) => mem_of_le I h_le h_mem }

/-- A specific witness of `I.nonempty` when `P` has a bottom element. -/
@[simp] theorem bot_mem {P : Type u_1} [order_bot P] {I : ideal P} : ⊥ ∈ I :=
  mem_of_le I bot_le (set.nonempty.some_mem (nonempty I))

/-- There is a bottom ideal when `P` has a bottom element. -/
protected instance order_bot {P : Type u_1} [order_bot P] : order_bot (ideal P) :=
  order_bot.mk (principal ⊥) partial_order.le partial_order.lt sorry sorry sorry sorry

/-- There is a top ideal when `P` has a top element. -/
protected instance order_top {P : Type u_1} [order_top P] : order_top (ideal P) :=
  order_top.mk (principal ⊤) partial_order.le partial_order.lt sorry sorry sorry sorry

/-- A specific witness of `I.directed` when `P` has joins. -/
theorem sup_mem {P : Type u_1} [semilattice_sup P] {I : ideal P} (x : P) (y : P) (H : x ∈ I) :
    y ∈ I → x ⊔ y ∈ I :=
  sorry

@[simp] theorem sup_mem_iff {P : Type u_1} [semilattice_sup P] {x : P} {y : P} {I : ideal P} :
    x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
  { mp :=
      fun (h : x ⊔ y ∈ I) =>
        { left := mem_of_le I le_sup_left h, right := mem_of_le I le_sup_right h },
    mpr := fun (h : x ∈ I ∧ y ∈ I) => sup_mem x y (and.left h) (and.right h) }

end ideal

/-- For a preorder `P`, `cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure cofinal (P : Type u_2) [preorder P] where
  carrier : set P
  mem_gt : ∀ (x : P), ∃ (y : P), ∃ (H : y ∈ carrier), x ≤ y

namespace cofinal

protected instance inhabited {P : Type u_1} [preorder P] : Inhabited (cofinal P) :=
  { default := mk set.univ sorry }

protected instance has_mem {P : Type u_1} [preorder P] : has_mem P (cofinal P) :=
  has_mem.mk fun (x : P) (D : cofinal P) => x ∈ carrier D

/-- A (noncomputable) element of a cofinal set lying above a given element. -/
def above {P : Type u_1} [preorder P] (D : cofinal P) (x : P) : P := classical.some (mem_gt D x)

theorem above_mem {P : Type u_1} [preorder P] (D : cofinal P) (x : P) : above D x ∈ D :=
  exists.elim (classical.some_spec (mem_gt D x))
    fun (a : classical.some (mem_gt D x) ∈ carrier D) (_x : x ≤ classical.some (mem_gt D x)) => a

theorem le_above {P : Type u_1} [preorder P] (D : cofinal P) (x : P) : x ≤ above D x :=
  exists.elim (classical.some_spec (mem_gt D x))
    fun (_x : classical.some (mem_gt D x) ∈ carrier D) (b : x ≤ classical.some (mem_gt D x)) => b

end cofinal

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
def sequence_of_cofinals {P : Type u_1} [preorder P] (p : P) {ι : Type u_2} [encodable ι]
    (𝒟 : ι → cofinal P) : ℕ → P :=
  sorry

theorem sequence_of_cofinals.monotone {P : Type u_1} [preorder P] (p : P) {ι : Type u_2}
    [encodable ι] (𝒟 : ι → cofinal P) : monotone (sequence_of_cofinals p 𝒟) :=
  sorry

theorem sequence_of_cofinals.encode_mem {P : Type u_1} [preorder P] (p : P) {ι : Type u_2}
    [encodable ι] (𝒟 : ι → cofinal P) (i : ι) :
    sequence_of_cofinals p 𝒟 (encodable.encode i + 1) ∈ 𝒟 i :=
  sorry

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `ideal_of_cofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_ideal_of_cofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_ideal_of_cofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def ideal_of_cofinals {P : Type u_1} [preorder P] (p : P) {ι : Type u_2} [encodable ι]
    (𝒟 : ι → cofinal P) : ideal P :=
  ideal.mk (set_of fun (x : P) => ∃ (n : ℕ), x ≤ sequence_of_cofinals p 𝒟 n) sorry sorry sorry

theorem mem_ideal_of_cofinals {P : Type u_1} [preorder P] (p : P) {ι : Type u_2} [encodable ι]
    (𝒟 : ι → cofinal P) : p ∈ ideal_of_cofinals p 𝒟 :=
  Exists.intro 0 (le_refl p)

/-- `ideal_of_cofinals p 𝒟` is `𝒟`-generic. -/
theorem cofinal_meets_ideal_of_cofinals {P : Type u_1} [preorder P] (p : P) {ι : Type u_2}
    [encodable ι] (𝒟 : ι → cofinal P) (i : ι) : ∃ (x : P), x ∈ 𝒟 i ∧ x ∈ ideal_of_cofinals p 𝒟 :=
  Exists.intro (sequence_of_cofinals p 𝒟 (encodable.encode i + 1))
    { left := sequence_of_cofinals.encode_mem p 𝒟 i,
      right :=
        Exists.intro (encodable.encode i + 1)
          (le_refl (sequence_of_cofinals p 𝒟 (encodable.encode i + 1))) }

end Mathlib


example : ∀ P Q : Prop, P → Q → P ∧ Q :=
begin
assume P Q : Prop,
assume p,
assume q,
show P ∧ Q,
apply and.intro,
exact p,
exact q,
end

example : ∀ P Q : Prop, P ∧ Q → P :=
begin
assume P Q,
assume pandq,
apply and.elim_left pandq,
end

example : ∀ P : Prop, P → ¬ ¬ P :=
begin
assume P,
assume p,
show ¬ ¬ P,
from
    begin
    assume np,
    have f : false := (np p),
    apply false.elim f,
    end
end

example : ∀ P Q : Prop, P ∧ ¬ P → Q :=
begin
intros P Q pandq,
--assume P Q pandq,
show Q,
from
begin
    have f : false :=
        (pandq.right) (pandq.left),
    apply false.elim f,
end,
end

example : ∀ P Q : Prop, P ∧ Q → Q ∧ P :=
begin
intros P Q paq,
apply and.intro,
exact paq.right,
exact paq.left,
end

example :
    ∀ R S W : Prop, R ∨ S → (R → W) → (S → W) → W :=
begin
intros R S W rors rq sq,
cases rors with pfR pfS,
exact (rq pfR),
exact (sq pfS),
end

example : ∀ P Q : Prop, P ∨ Q → Q ∨ P :=
begin
intros P Q porq,
cases porq with p q,
--exact or.intro_right Q p,
exact or.inr p,
exact or.inl q,
end

example : ∀ P Q : Prop, ¬ (P ∧ Q) → (¬ P ∨ ¬ Q) :=
begin
intros P Q npandq,
end

example : ∀ P Q : Prop, ¬ P ∧ ¬ Q → ¬ (P ∨ Q)  :=
begin
intros P Q npandq,
have np := npandq.left,
have nq := npandq.right,
assume porq,
cases porq with p q,
contradiction,
contradiction,
end

open classical
example : ∀ P Q : Prop, ¬ (P ∨ Q)  → ¬ P ∧ ¬ Q :=
begin
intros,
cases (em P) with p np,
have porq := or.intro_left Q p,
contradiction,
cases (em Q) with q nq,
have porq := or.intro_right P q,
contradiction,
apply and.intro np nq,
end

axiom em : ∀ P, P ∨ ¬ P

variable X : Prop
#reduce (em X)

example : forall P Q : Prop, P → (true ∨ false) :=
begin
intros,
cases (em P) with p np,
end


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Alex J. Best, Johan Commelin, Eric Rodriguez, Ruben Van de Velde

! This file was ported from Lean 3 source module field_theory.finite.galois_field
! leanprover-community/mathlib commit bbeb185db4ccee8ed07dc48449414ebfa39cb821
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Algebra
import Mathbin.Data.Zmod.Algebra
import Mathbin.FieldTheory.Finite.Basic
import Mathbin.FieldTheory.Galois

/-!
# Galois fields

If `p` is a prime number, and `n` a natural number,
then `galois_field p n` is defined as the splitting field of `X^(p^n) - X` over `zmod p`.
It is a finite field with `p ^ n` elements.

## Main definition

* `galois_field p n` is a field with `p ^ n` elements

## Main Results

- `galois_field.alg_equiv_galois_field`: Any finite field is isomorphic to some Galois field
- `finite_field.alg_equiv_of_card_eq`: Uniqueness of finite fields : algebra isomorphism
- `finite_field.ring_equiv_of_card_eq`: Uniqueness of finite fields : ring isomorphism

-/

noncomputable section

open Polynomial

open Polynomial

theorem galois_poly_separable {K : Type _} [Field K] (p q : ℕ) [CharP K p] (h : p ∣ q) :
    Separable (X ^ q - X : K[X]) := by
  use 1, X ^ q - X - 1
  rw [← CharP.cast_eq_zero_iff K[X] p] at h
  rw [derivative_sub, derivative_X_pow, derivative_X, C_eq_nat_cast, h]
  ring
#align galois_poly_separable galois_poly_separable

/-- A finite field with `p ^ n` elements.
Every field with the same cardinality is (non-canonically)
isomorphic to this field. -/
def GaloisField (p : ℕ) [Fact p.Prime] (n : ℕ) :=
  SplittingField (X ^ p ^ n - X : (ZMod p)[X])deriving Field
#align galois_field GaloisField

instance : Inhabited (@GaloisField 2 (Fact.mk Nat.prime_two) 1) :=
  ⟨37⟩

namespace GaloisField

variable (p : ℕ) [Fact p.Prime] (n : ℕ)

instance : Algebra (ZMod p) (GaloisField p n) :=
  SplittingField.algebra _

instance : IsSplittingField (ZMod p) (GaloisField p n) (X ^ p ^ n - X) :=
  Polynomial.IsSplittingField.splittingField _

instance : CharP (GaloisField p n) p :=
  (Algebra.charP_iff (ZMod p) (GaloisField p n) p).mp (by infer_instance)

instance : Fintype (GaloisField p n) :=
  by
  dsimp only [GaloisField]
  exact FiniteDimensional.fintypeOfFintype (ZMod p) (GaloisField p n)

theorem finrank {n} (h : n ≠ 0) : FiniteDimensional.finrank (ZMod p) (GaloisField p n) = n :=
  by
  set g_poly := (X ^ p ^ n - X : (ZMod p)[X])
  have hp : 1 < p := (Fact.out (Nat.Prime p)).one_lt
  have aux : g_poly ≠ 0 := FiniteField.x_pow_card_pow_sub_x_ne_zero _ h hp
  have key : Fintype.card (g_poly.rootSet (GaloisField p n)) = g_poly.natDegree :=
    card_root_set_eq_nat_degree (galois_poly_separable p _ (dvd_pow (dvd_refl p) h))
      (splitting_field.splits g_poly)
  have nat_degree_eq : g_poly.natDegree = p ^ n :=
    FiniteField.x_pow_card_pow_sub_x_natDegree_eq _ h hp
  rw [nat_degree_eq] at key
  suffices g_poly.rootSet (GaloisField p n) = Set.univ
    by
    simp_rw [this, ← Fintype.ofEquiv_card (Equiv.Set.univ _)] at key
    rw [@card_eq_pow_finrank (ZMod p), ZMod.card] at key
    exact Nat.pow_right_injective (Nat.Prime.one_lt' p).out key
  rw [Set.eq_univ_iff_forall]
  suffices
    ∀ (x) (hx : x ∈ (⊤ : Subalgebra (ZMod p) (GaloisField p n))),
      x ∈ (X ^ p ^ n - X : (ZMod p)[X]).rootSet (GaloisField p n)
    by simpa
  rw [← splitting_field.adjoin_root_set]
  simp_rw [Algebra.mem_adjoin_iff]
  intro x hx
  -- We discharge the `p = 0` separately, to avoid typeclass issues on `zmod p`.
  cases p
  cases hp
  apply Subring.closure_induction hx <;> clear! x <;> simp_rw [mem_root_set_of_ne aux]
  · rintro x (⟨r, rfl⟩ | hx)
    · simp only [aeval_X_pow, aeval_X, AlgHom.map_sub]
      rw [← map_pow, ZMod.pow_card_pow, sub_self]
    · dsimp only [GaloisField] at hx
      rwa [mem_root_set_of_ne aux] at hx
      infer_instance
  · dsimp only [g_poly]
    rw [← coeff_zero_eq_aeval_zero']
    simp only [coeff_X_pow, coeff_X_zero, sub_zero, _root_.map_eq_zero, ite_eq_right_iff,
      one_ne_zero, coeff_sub]
    intro hn
    exact Nat.not_lt_zero 1 (pow_eq_zero hn.symm ▸ hp)
  · simp
  · simp only [aeval_X_pow, aeval_X, AlgHom.map_sub, add_pow_char_pow, sub_eq_zero]
    intro x y hx hy
    rw [hx, hy]
  · intro x hx
    simp only [sub_eq_zero, aeval_X_pow, aeval_X, AlgHom.map_sub, sub_neg_eq_add] at *
    rw [neg_pow, hx, CharP.neg_one_pow_char_pow]
    simp
  · simp only [aeval_X_pow, aeval_X, AlgHom.map_sub, mul_pow, sub_eq_zero]
    intro x y hx hy
    rw [hx, hy]
#align galois_field.finrank GaloisField.finrank

theorem card (h : n ≠ 0) : Fintype.card (GaloisField p n) = p ^ n :=
  by
  let b := IsNoetherian.finsetBasis (ZMod p) (GaloisField p n)
  rw [Module.card_fintype b, ← FiniteDimensional.finrank_eq_card_basis b, ZMod.card, finrank p h]
#align galois_field.card GaloisField.card

theorem splits_zMod_x_pow_sub_x : Splits (RingHom.id (ZMod p)) (X ^ p - X) :=
  by
  have hp : 1 < p := (Fact.out (Nat.Prime p)).one_lt
  have h1 : roots (X ^ p - X : (ZMod p)[X]) = finset.univ.val :=
    by
    convert FiniteField.roots_x_pow_card_sub_x _
    exact (ZMod.card p).symm
  have h2 := FiniteField.x_pow_card_sub_x_natDegree_eq (ZMod p) hp
  -- We discharge the `p = 0` separately, to avoid typeclass issues on `zmod p`.
  cases p
  cases hp
  rw [splits_iff_card_roots, h1, ← Finset.card_def, Finset.card_univ, h2, ZMod.card]
#align galois_field.splits_zmod_X_pow_sub_X GaloisField.splits_zMod_x_pow_sub_x

/-- A Galois field with exponent 1 is equivalent to `zmod` -/
def equivZmodP : GaloisField p 1 ≃ₐ[ZMod p] ZMod p :=
  have h : (X ^ p ^ 1 : (ZMod p)[X]) = X ^ Fintype.card (ZMod p) := by rw [pow_one, ZMod.card p]
  have inst : IsSplittingField (ZMod p) (ZMod p) (X ^ p ^ 1 - X) :=
    by
    rw [h]
    infer_instance
  (is_splitting_field.alg_equiv (ZMod p) (X ^ p ^ 1 - X : (ZMod p)[X])).symm
#align galois_field.equiv_zmod_p GaloisField.equivZmodP

variable {K : Type _} [Field K] [Fintype K] [Algebra (ZMod p) K]

theorem splits_x_pow_card_sub_x : Splits (algebraMap (ZMod p) K) (X ^ Fintype.card K - X) :=
  (FiniteField.HasSub.Sub.Polynomial.isSplittingField K (ZMod p)).Splits
#align galois_field.splits_X_pow_card_sub_X GaloisField.splits_x_pow_card_sub_x

theorem isSplittingField_of_card_eq (h : Fintype.card K = p ^ n) :
    IsSplittingField (ZMod p) K (X ^ p ^ n - X) :=
  h ▸ FiniteField.HasSub.Sub.Polynomial.isSplittingField K (ZMod p)
#align galois_field.is_splitting_field_of_card_eq GaloisField.isSplittingField_of_card_eq

instance (priority := 100) {K K' : Type _} [Field K] [Field K'] [Finite K'] [Algebra K K'] :
    IsGalois K K' := by
  cases nonempty_fintype K'
  obtain ⟨p, hp⟩ := CharP.exists K
  haveI : CharP K p := hp
  haveI : CharP K' p := charP_of_injective_algebraMap' K K' p
  exact
    IsGalois.of_separable_splitting_field
      (galois_poly_separable p (Fintype.card K')
        (let ⟨n, hp, hn⟩ := FiniteField.card K' p
        hn.symm ▸ dvd_pow_self p n.NeZero))

/-- Any finite field is (possibly non canonically) isomorphic to some Galois field. -/
def algEquivGaloisField (h : Fintype.card K = p ^ n) : K ≃ₐ[ZMod p] GaloisField p n :=
  haveI := is_splitting_field_of_card_eq _ _ h
  is_splitting_field.alg_equiv _ _
#align galois_field.alg_equiv_galois_field GaloisField.algEquivGaloisField

end GaloisField

namespace FiniteField

variable {K : Type _} [Field K] [Fintype K] {K' : Type _} [Field K'] [Fintype K']

/-- Uniqueness of finite fields:
  Any two finite fields of the same cardinality are (possibly non canonically) isomorphic-/
def algEquivOfCardEq (p : ℕ) [Fact p.Prime] [Algebra (ZMod p) K] [Algebra (ZMod p) K']
    (hKK' : Fintype.card K = Fintype.card K') : K ≃ₐ[ZMod p] K' :=
  by
  have : CharP K p := by
    rw [← Algebra.charP_iff (ZMod p) K p]
    exact ZMod.charP p
  have : CharP K' p := by
    rw [← Algebra.charP_iff (ZMod p) K' p]
    exact ZMod.charP p
  choose n a hK using FiniteField.card K p
  choose n' a' hK' using FiniteField.card K' p
  rw [hK, hK'] at hKK'
  have hGalK := GaloisField.algEquivGaloisField p n hK
  have hK'Gal := (GaloisField.algEquivGaloisField p n' hK').symm
  rw [Nat.pow_right_injective (Fact.out (Nat.Prime p)).one_lt hKK'] at *
  use AlgEquiv.trans hGalK hK'Gal
#align finite_field.alg_equiv_of_card_eq FiniteField.algEquivOfCardEq

/-- Uniqueness of finite fields:
  Any two finite fields of the same cardinality are (possibly non canonically) isomorphic-/
def ringEquivOfCardEq (hKK' : Fintype.card K = Fintype.card K') : K ≃+* K' :=
  by
  choose p _char_p_K using CharP.exists K
  choose p' _char_p'_K' using CharP.exists K'
  skip
  choose n hp hK using FiniteField.card K p
  choose n' hp' hK' using FiniteField.card K' p'
  have hpp' : p = p' :=
    by
    -- := eq_prime_of_eq_prime_pow
    by_contra hne
    have h2 := Nat.coprime_pow_primes n n' hp hp' hne
    rw [(Eq.congr hK hK').mp hKK', Nat.coprime_self, pow_eq_one_iff (PNat.ne_zero n')] at h2
    exact Nat.Prime.ne_one hp' h2
    all_goals infer_instance
  rw [← hpp'] at *
  haveI := fact_iff.2 hp
  exact alg_equiv_of_card_eq p hKK'
#align finite_field.ring_equiv_of_card_eq FiniteField.ringEquivOfCardEq

end FiniteField


import data.fintype.basic
import data.set
import data.finset
import tactic
import size

noncomputable theory
localized "attribute [instance, priority 100000] classical.prop_decidable
  noncomputable theory" in classical
open_locale classical
open finset

universes u v

-- A concrete matroid
@[ext]
-- M: why not square brackets around fintype parameter?
structure matroid_on (γ : Type u) (finite : fintype γ) :=
  (r : finset γ → ℤ)
  (R0 : ∀ (X : finset γ), 0 ≤ r X)
  (R1 : ∀ (X : finset γ), r X ≤ size X)
  (R2 : ∀ {X Y : finset γ}, X ⊆ Y → r X ≤ r Y)
  (R3 : ∀ (X Y : finset γ), r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y)

-- Packing the matroid with the ground type
structure matroid :=
  (γ : Type u)
  [class_finite : fintype γ]
  (mat : @matroid_on γ class_finite) -- M: not need for @

/--
Type with matroids interpretations (for example matroid minors) may implement
this to get access to the `↟` coercion arrow.  (Note: this is getting
around a problem with `has_coe` class resolution where universe
variables do not seem to be inferrable.)

-- M: simple_graphs2 seems to be missing from the repo.
See simple_graphs2 for where this came from.
-/
class has_coe_to_matroid (α : Type u) :=
(coe : α → matroid.{v})

/-
If only `has_coe` could infer the universe variables, this wouldn't be needed.
-/
notation `↟`:max x:max := has_coe_to_matroid.coe x

instance (γ: Type u) [finite : fintype γ]:
    has_coe_to_matroid (matroid_on γ finite) :=
    ⟨λ G, ⟨γ, G⟩⟩

namespace matroid_on
variables {γ : Type u} [finite : fintype γ] (M : matroid_on γ finite)
abbreviation E (M : matroid_on γ finite) : finset γ := univ

@[simp]
lemma r_empty_eq_zero: M.r ∅ = 0 :=
by linarith [(M.R0 ∅), (M.R1 ∅), @size_empty γ]

@[simp]
lemma r_univ_compl_eq_zero : M.r M.Eᶜ = 0 :=
by { convert M.r_empty_eq_zero, convert_to ⊤ᶜ = _, simp only [compl_top], refl }
end matroid_on

namespace matroid
variables (M : matroid)

abbreviation r := M.mat.r
abbreviation E := @matroid_on.E M.γ M.class_finite M.mat

@[simp] def r_eq_empty_zero :=
  let γ := M.γ,
      finite := M.class_finite in
    @matroid_on.r_empty_eq_zero γ finite M.mat
#check r_eq_empty_zero

-- M: What? Typechecking seems to work fine? Oh ok, if uncommenting the type annotation.
/- note that the typechecking doesn't work here -/
@[simp] def r_univ_compl_eq_zero /- : M.mat.r M.mat.Eᶜ = 0 -/ :=
  let γ := M.γ,
    finite := M.class_finite in
    @matroid_on.r_univ_compl_eq_zero γ finite M.mat
#check r_univ_compl_eq_zero

/-- if we want a nicer type -/
structure struct_r_univ_compl_eq_zero :=
  (finite : fintype M.γ)
  (term : M.r M.Eᶜ = 0)
@[simp] def nice_r_univ_compl_eq_zero :=
  let γ := M.γ,
    finite := M.class_finite in
  struct_r_univ_compl_eq_zero.term (struct_r_univ_compl_eq_zero.mk finite (r_univ_compl_eq_zero M))
#check nice_r_univ_compl_eq_zero

end matroid


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

open_locale nat rat real big_operators topological_space

theorem amc12a_2008_p2
  (x : ℝ)
  (h₀ : x * (1 / 2 + 2 / 3) = 1) :
  x = 6 / 7 :=
begin
  linarith,
end


/-
Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu

! This file was ported from Lean 3 source module data.polynomial.cardinal
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Basic
import Mathbin.SetTheory.Cardinal.Ordinal

/-!
# Cardinality of Polynomial Ring

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

The reuslt in this file is that the cardinality of `R[X]` is at most the maximum
of `#R` and `ℵ₀`.
-/

universe u

open Cardinal Polynomial

open Cardinal

namespace Polynomial

/- warning: polynomial.cardinal_mk_eq_max -> Polynomial.cardinal_mk_eq_max is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] [_inst_2 : Nontrivial.{u1} R], Eq.{succ (succ u1)} Cardinal.{u1} (Cardinal.mk.{u1} (Polynomial.{u1} R _inst_1)) (LinearOrder.max.{succ u1} Cardinal.{u1} (ConditionallyCompleteLinearOrder.toLinearOrder.{succ u1} Cardinal.{u1} (ConditionallyCompleteLinearOrderBot.toConditionallyCompleteLinearOrder.{succ u1} Cardinal.{u1} Cardinal.conditionallyCompleteLinearOrderBot.{u1})) (Cardinal.mk.{u1} R) Cardinal.aleph0.{u1})
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] [_inst_2 : Nontrivial.{u1} R], Eq.{succ (succ u1)} Cardinal.{u1} (Cardinal.mk.{u1} (Polynomial.{u1} R _inst_1)) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Cardinal.mk.{u1} R) Cardinal.aleph0.{u1})
Case conversion may be inaccurate. Consider using '#align polynomial.cardinal_mk_eq_max Polynomial.cardinal_mk_eq_maxₓ'. -/
@[simp]
theorem cardinal_mk_eq_max {R : Type u} [Semiring R] [Nontrivial R] : (#R[X]) = max (#R) ℵ₀ :=
  (toFinsuppIso R).toEquiv.cardinal_eq.trans <|
    by
    rw [AddMonoidAlgebra, mk_finsupp_lift_of_infinite, lift_uzero, max_comm]
    rfl
#align polynomial.cardinal_mk_eq_max Polynomial.cardinal_mk_eq_max

/- warning: polynomial.cardinal_mk_le_max -> Polynomial.cardinal_mk_le_max is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], LE.le.{succ u1} Cardinal.{u1} Cardinal.hasLe.{u1} (Cardinal.mk.{u1} (Polynomial.{u1} R _inst_1)) (LinearOrder.max.{succ u1} Cardinal.{u1} (ConditionallyCompleteLinearOrder.toLinearOrder.{succ u1} Cardinal.{u1} (ConditionallyCompleteLinearOrderBot.toConditionallyCompleteLinearOrder.{succ u1} Cardinal.{u1} Cardinal.conditionallyCompleteLinearOrderBot.{u1})) (Cardinal.mk.{u1} R) Cardinal.aleph0.{u1})
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R], LE.le.{succ u1} Cardinal.{u1} Cardinal.instLECardinal.{u1} (Cardinal.mk.{u1} (Polynomial.{u1} R _inst_1)) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Cardinal.mk.{u1} R) Cardinal.aleph0.{u1})
Case conversion may be inaccurate. Consider using '#align polynomial.cardinal_mk_le_max Polynomial.cardinal_mk_le_maxₓ'. -/
theorem cardinal_mk_le_max {R : Type u} [Semiring R] : (#R[X]) ≤ max (#R) ℵ₀ :=
  by
  cases subsingleton_or_nontrivial R
  · exact (mk_eq_one _).trans_le (le_max_of_le_right one_le_aleph_0)
  · exact cardinal_mk_eq_max.le
#align polynomial.cardinal_mk_le_max Polynomial.cardinal_mk_le_max

end Polynomial


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

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_510
  (x y : ℝ)
  (h₀ : x + y = 13)
  (h₁ : x * y = 24) :
  real.sqrt (x^2 + y^2) = 11 :=
begin
  norm_num [real.sqrt_eq_cases] at *,
  nlinarith,
end


import tactic
import data.set
import .sequences
import .topology
import .negative_sets

noncomputable theory
open_locale classical
open espace_metrique

namespace real

lemma Sup_sub_lt_eps {S: set ℝ}: S.nonempty → bdd_above S → ∀ ε > 0, ∃ x ∈ S, Sup S - x < ε := begin
intros Hne Hbdd,
by_contra,
push_neg at a,
obtain ⟨ ε, ⟨ hε, hyp ⟩ ⟩ := a,
have: ∀ (x: ℝ), x ∈ S → x ≤ Sup S - ε := begin
intros x hx,
have hyp := hyp x hx,
linarith,
end,
have habsurd := cSup_le Hne this,
linarith,
end

lemma Sup_dist_lt_eps {S: set ℝ}: S.nonempty → bdd_above S → ∀ ε > 0, ∃ x ∈ S, d (Sup S) x < ε := begin
  intros Hne Hbdd,
  intros ε hε,
  obtain ⟨ x, hx, hs_lt ⟩ := Sup_sub_lt_eps Hne Hbdd ε hε,
  use x,
  split,
  exact hx,
  rw dist_eq,
  apply abs_lt_of_lt_of_neg_lt,
  exact hs_lt,
  calc -(Sup S - x) = x - Sup S : by simp
      ... ≤ Sup S - Sup S : (sub_le_sub_right (le_cSup Hbdd hx) (Sup S))
      ... ≤ 0 : by simp
      ... < ε : hε
end

lemma Sup_is_a_cv_seq (S: set ℝ):
  S.nonempty → bdd_above S → adhere_ens S (Sup S) := begin
  intros hnn hbdd,
  have: ∀ (N: ℕ), ∃ x ∈ S, d (Sup S) x ≤ 1/(N + 1) := λ N,
  let ⟨ x, ha, hb ⟩ := (Sup_dist_lt_eps hnn hbdd (1 / (N + 1)) (nat.one_div_pos_of_nat))
  in ⟨ x, ⟨ ha, le_of_lt hb ⟩ ⟩,
  choose x hrange h using this,
  use x,
  split,
  exact hrange,
  exact converge_of_dist_lt_one_div_succ h,
end

-- suffit de prendre une suite qui converge vers Sup S
-- puis de prendre la suite opposée, qui converge vers -Sup S = Inf S
lemma Inf_is_a_cv_seq (S: set ℝ):
  S.nonempty → bdd_below S → adhere_ens S (Inf S) := begin
  intros Hne Hbdd,
  apply negative_set.adhere_ens_iff.2,
  rw Inf_def,
  simp,
  exact Sup_is_a_cv_seq (negative_set S) (negative_set.nonempty Hne) (negative_set.bdd_above Hbdd)
  end

-- sous hypothèse que le sup ou l'inf ne sont pas dans l'ensemble, ils forment des points limites.
lemma Sup_is_a_limit_point (S: set ℝ):
  (Sup S) ∉ S → S.nonempty → bdd_above S → point_limite S (Sup S) := begin
  intros hsup hne hbdd,
  obtain ⟨ x, hrange, hcv ⟩ := Sup_is_a_cv_seq S hne hbdd,
  use x,
  split,
  rw set.diff_singleton_eq_self,
  exact hrange,
  exact hsup,
  exact hcv
end

lemma Inf_is_a_limit_point (S: set ℝ):
  (Inf S) ∉ S → S.nonempty → bdd_below S → point_limite S (Inf S) :=
  begin
  intros hinf hne hbdd,
  obtain ⟨ x, hrange, hcv ⟩ := real.Inf_is_a_cv_seq S hne hbdd,
  use x,
  split,
  rw set.diff_singleton_eq_self,
  exact hrange,
  exact hinf,
  exact hcv
  end

end real

namespace set.finite
variables {X: Type}

lemma has_greatest_element [decidable_linear_order X] (S: set X):
  S.finite → S.nonempty → ∃ x ∈ S, is_greatest S x := begin
  intros Hf Hnn,
  lift S to (finset X) using Hf,
  use (finset.max' S Hnn),
  have Hmem := finset.max'_mem S Hnn,
  split,
  exact Hmem,
  rw is_greatest,
  split,
  exact Hmem,
  rw upper_bounds,
  simp,
  exact finset.le_max' S Hnn,
end

lemma has_a_reached_sup
  [conditionally_complete_linear_order X] {S: set X}:
  S.finite → S.nonempty → Sup S ∈ S := begin
  intros Hf Hnn,
  obtain ⟨ x, Hmem, Hgt ⟩ := (has_greatest_element S Hf Hnn),
  rw is_greatest.cSup_eq Hgt,
  exact Hmem,
end
end set.finite


-- ---------------------------------------------------------------------
-- Demostrar que
--    (s \ t) \ u ⊆ s \ (t ∪ u)
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
sorry


import data.nat.basic
import data.nat.prime
import tactic.norm_num

open nat

-- https://www.dpmms.cam.ac.uk/study/II/NumberTheory/2019-2020/number_theory-19-1.pdf
-- A proof of question 5 from here

lemma division_lemma { a n : ℕ } ( ha : a ≥ 1 ) : a - 1 ∣ a ^ n - 1 :=
begin
  apply dvd_of_mod_eq_zero,
  induction n with n, simp,
  suffices: (a^n * (a - 1 + 1) - 1) % (a - 1) = 0,
    by rwa nat.sub_add_cancel ha at this,
  rw [mul_add, mul_one, nat.add_sub_assoc (pow_pos ha _)], simpa
end

lemma division_lemma' { a p q : ℕ } ( ha : a ≥ 1 ) : a ^ p - 1 ∣ a ^ (p * q) - 1 :=
begin
  cases p, simp,
  rw nat.pow_mul,
  apply division_lemma (pow_pos ‹a ≥ 1› _),
end

lemma eq_add_of_sub_eq'' { a m n : ℕ } ( ha : a ≥ m ) : a - m = n → a = n + m :=
  (nat.sub_eq_iff_eq_add ha).1

lemma pow_monotonic { a m n : ℕ } ( ha : a ≥ 2 ) ( k : a^m ≥ a^n ) : m ≥ n :=
  le_of_not_gt (λ r, not_le_of_lt (pow_lt_pow_of_lt_right ha r) k)

lemma pow_inj { a m n : ℕ } ( ha : a ≥ 2 ) ( k : a^m = a^n ) : m = n :=
  by apply le_antisymm; apply pow_monotonic ha; apply le_of_eq; rw k

lemma question5i { a n : ℕ } { ha : a > 1 } { hn : n > 1 } : prime (a^n - 1) → a = 2 ∧ prime n :=
begin
  have: a ≥ 1, from le_of_succ_le ‹a ≥ 2›,
  have: n ≥ 1, from le_of_succ_le ‹n ≥ 2›,
  have: a^n > 0, from pow_pos ‹a > 0› n,
  intro b, split,
    cases b.right _ (division_lemma ‹a ≥ 1›),
      apply eq_add_of_sub_eq'' ‹a ≥ 1› ‹a - 1 = 1›,
    have: a^n = a^1,
      rw nat.pow_one, from nat.sub_cancel ‹a^n ≥ 1› ‹a ≥ 1› ‹a - 1 = a^n - 1›.symm,
    exfalso,
    have: a^n > a^1 := pow_lt_pow_of_lt_right ‹a > 1› ‹n > 1›,
    apply ne_of_gt ‹a^n > a^1› ‹a^n = a^1›,

  refine ⟨‹n ≥ 2›, _⟩,
  intros m _,
  have: a^m ≥ 1, from pow_pos ‹a ≥ 1› m,
  have: a^m - 1 ∣ a^_ - 1 := division_lemma' ‹a ≥ 1›,
  rw nat.mul_div_cancel_left' ‹m ∣ n› at this,
  apply or.imp _ _ (b.right (a^m - 1) this); intro,
    have: a^m ≤ a,
    by calc a^m ≤ 2 : le_of_eq $ eq_add_of_sub_eq'' ‹a^m ≥ 1› ‹a^m - 1 = 1›
            ... ≤ a : ‹a ≥ 2›,
    have: m ≤ 1, apply pow_monotonic ‹a ≥ 2›, rwa nat.pow_one,
    have: m > 0 := pos_of_dvd_of_pos ‹m ∣ n› ‹n > 0›,
    apply le_antisymm ‹m ≤ 1› ‹m > 0›,
  have: a^m = a^n, from nat.sub_cancel ‹a^m ≥ 1› ‹a^n ≥ 1› ‹a^m - 1 = a^n - 1›,
  exact pow_inj ‹a ≥ 2› this,
end

lemma question5ii: ¬ (∀ { a n : ℕ }, a = 2 ∧ prime n → prime (a^n - 1)) :=
begin
  intro h,
  have: prime 11   := by norm_num,
  have: prime 2047 := h ⟨rfl, ‹prime 11›⟩,
  norm_num at this
end


/-
Copyright (c) 2021 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.calculus.deriv
import analysis.calculus.mean_value
import analysis.convex.topology

/-!
# Symmetry of the second derivative

We show that, over the reals, the second derivative is symmetric.

The most precise result is `convex.second_derivative_within_at_symmetric`. It asserts that,
if a function is differentiable inside a convex set `s` with nonempty interior, and has a second
derivative within `s` at a point `x`, then this second derivative at `x` is symmetric. Note that
this result does not require continuity of the first derivative.

The following particular cases of this statement are especially relevant:

`second_derivative_symmetric_of_eventually` asserts that, if a function is differentiable on a
neighborhood of `x`, and has a second derivative at `x`, then this second derivative is symmetric.

`second_derivative_symmetric` asserts that, if a function is differentiable, and has a second
derivative at `x`, then this second derivative is symmetric.

## Implementation note

For the proof, we obtain an asymptotic expansion to order two of `f (x + v + w) - f (x + v)`, by
using the mean value inequality applied to a suitable function along the
segment `[x + v, x + v + w]`. This expansion involves `f'' ⬝ w` as we move along a segment directed
by `w` (see `convex.taylor_approx_two_segment`).

Consider the alternate sum `f (x + v + w) + f x - f (x + v) - f (x + w)`, corresponding to the
values of `f` along a rectangle based at `x` with sides `v` and `w`. One can write it using the two
sides directed by `w`, as `(f (x + v + w) - f (x + v)) - (f (x + w) - f x)`. Together with the
previous asymptotic expansion, one deduces that it equals `f'' v w + o(1)` when `v, w` tends to `0`.
Exchanging the roles of `v` and `w`, one instead gets an asymptotic expansion `f'' w v`, from which
the equality `f'' v w = f'' w v` follows.

In our most general statement, we only assume that `f` is differentiable inside a convex set `s`, so
a few modifications have to be made. Since we don't assume continuity of `f` at `x`, we consider
instead the rectangle based at `x + v + w` with sides `v` and `w`,
in `convex.is_o_alternate_sum_square`, but the argument is essentially the same. It only works
when `v` and `w` both point towards the interior of `s`, to make sure that all the sides of the
rectangle are contained in `s` by convexity. The general case follows by linearity, though.
-/

open asymptotics set
open_locale topology

variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E]
[normed_add_comm_group F] [normed_space ℝ F]
{s : set E} (s_conv : convex ℝ s)
{f : E → F} {f' : E → (E →L[ℝ] F)} {f'' : E →L[ℝ] (E →L[ℝ] F)}
(hf : ∀ x ∈ interior s, has_fderiv_at f (f' x) x)
{x : E} (xs : x ∈ s) (hx : has_fderiv_within_at f' f'' (interior s) x)

include s_conv xs hx hf

/-- Assume that `f` is differentiable inside a convex set `s`, and that its derivative `f'` is
differentiable at a point `x`. Then, given two vectors `v` and `w` pointing inside `s`, one can
Taylor-expand to order two the function `f` on the segment `[x + h v, x + h (v + w)]`, giving a
bilinear estimate for `f (x + hv + hw) - f (x + hv)` in terms of `f' w` and of `f'' ⬝ w`, up to
`o(h^2)`.

This is a technical statement used to show that the second derivative is symmetric.
-/
lemma convex.taylor_approx_two_segment
  {v w : E} (hv : x + v ∈ interior s) (hw : x + v + w ∈ interior s) :
  (λ h : ℝ, f (x + h • v + h • w) - f (x + h • v) - h • f' x w
    - h^2 • f'' v w - (h^2/2) • f'' w w) =o[𝓝[>] 0] (λ h, h^2) :=
begin
  -- it suffices to check that the expression is bounded by `ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2` for
  -- small enough `h`, for any positive `ε`.
  apply is_o.trans_is_O (is_o_iff.2 (λ ε εpos, _)) (is_O_const_mul_self ((‖v‖ + ‖w‖) * ‖w‖) _ _),
  -- consider a ball of radius `δ` around `x` in which the Taylor approximation for `f''` is
  -- good up to `δ`.
  rw [has_fderiv_within_at, has_fderiv_at_filter, is_o_iff] at hx,
  rcases metric.mem_nhds_within_iff.1 (hx εpos) with ⟨δ, δpos, sδ⟩,
  have E1 : ∀ᶠ h in 𝓝[>] (0:ℝ), h * (‖v‖ + ‖w‖) < δ,
  { have : filter.tendsto (λ h, h * (‖v‖ + ‖w‖)) (𝓝[>] (0:ℝ)) (𝓝 (0 * (‖v‖ + ‖w‖))) :=
      (continuous_id.mul continuous_const).continuous_within_at,
    apply (tendsto_order.1 this).2 δ,
    simpa only [zero_mul] using δpos },
  have E2 : ∀ᶠ h in 𝓝[>] (0:ℝ), (h : ℝ) < 1 :=
    mem_nhds_within_Ioi_iff_exists_Ioo_subset.2
      ⟨(1 : ℝ), by simp only [mem_Ioi, zero_lt_one], λ x hx, hx.2⟩,
  filter_upwards [E1, E2, self_mem_nhds_within] with h hδ h_lt_1 hpos,
  -- we consider `h` small enough that all points under consideration belong to this ball,
  -- and also with `0 < h < 1`.
  replace hpos : 0 < h := hpos,
  have xt_mem : ∀ t ∈ Icc (0 : ℝ) 1, x + h • v + (t * h) • w ∈ interior s,
  { assume t ht,
    have : x + h • v ∈ interior s :=
      s_conv.add_smul_mem_interior xs hv ⟨hpos, h_lt_1.le⟩,
    rw [← smul_smul],
    apply s_conv.interior.add_smul_mem this _ ht,
    rw add_assoc at hw,
    rw [add_assoc, ← smul_add],
    exact s_conv.add_smul_mem_interior xs hw ⟨hpos, h_lt_1.le⟩ },
  -- define a function `g` on `[0,1]` (identified with `[v, v + w]`) such that `g 1 - g 0` is the
  -- quantity to be estimated. We will check that its derivative is given by an explicit
  -- expression `g'`, that we can bound. Then the desired bound for `g 1 - g 0` follows from the
  -- mean value inequality.
  let g := λ t, f (x + h • v + (t * h) • w) - (t * h) • f' x w  - (t * h^2) • f'' v w
    - ((t * h)^2/2) • f'' w w,
  set g' := λ t, f' (x + h • v + (t * h) • w) (h • w) - h • f' x w
    - h^2 • f'' v w - (t * h^2) • f'' w w with hg',
  -- check that `g'` is the derivative of `g`, by a straightforward computation
  have g_deriv : ∀ t ∈ Icc (0 : ℝ) 1, has_deriv_within_at g (g' t) (Icc 0 1) t,
  { assume t ht,
    apply_rules [has_deriv_within_at.sub, has_deriv_within_at.add],
    { refine (hf _ _).comp_has_deriv_within_at _ _,
      { exact xt_mem t ht },
      apply_rules [has_deriv_at.has_deriv_within_at, has_deriv_at.const_add,
        has_deriv_at.smul_const, has_deriv_at_mul_const] },
    { apply_rules [has_deriv_at.has_deriv_within_at, has_deriv_at.smul_const,
        has_deriv_at_mul_const] },
    { apply_rules [has_deriv_at.has_deriv_within_at, has_deriv_at.smul_const,
        has_deriv_at_mul_const] },
    { suffices H : has_deriv_within_at (λ u, ((u * h) ^ 2 / 2) • f'' w w)
        (((((2 : ℕ) : ℝ) * (t * h) ^ (2  - 1) * (1 * h))/2) • f'' w w) (Icc 0 1) t,
      { convert H using 2,
        simp only [one_mul, nat.cast_bit0, pow_one, nat.cast_one],
        ring },
      apply_rules [has_deriv_at.has_deriv_within_at, has_deriv_at.smul_const, has_deriv_at_id',
        has_deriv_at.pow, has_deriv_at.mul_const] } },
  -- check that `g'` is uniformly bounded, with a suitable bound `ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2`.
  have g'_bound : ∀ t ∈ Ico (0 : ℝ) 1, ‖g' t‖ ≤ ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2,
  { assume t ht,
    have I : ‖h • v + (t * h) • w‖ ≤ h * (‖v‖ + ‖w‖) := calc
      ‖h • v + (t * h) • w‖ ≤ ‖h • v‖ + ‖(t * h) • w‖ : norm_add_le _ _
      ... = h * ‖v‖ + t * (h * ‖w‖) :
        by simp only [norm_smul, real.norm_eq_abs, hpos.le, abs_of_nonneg, abs_mul, ht.left,
                      mul_assoc]
      ... ≤ h * ‖v‖ + 1 * (h * ‖w‖) :
        add_le_add le_rfl (mul_le_mul_of_nonneg_right ht.2.le
          (mul_nonneg hpos.le (norm_nonneg _)))
      ... = h * (‖v‖ + ‖w‖) : by ring,
    calc ‖g' t‖ = ‖(f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)) (h • w)‖ :
    begin
      rw hg',
      have : h * (t * h) = t * (h * h), by ring,
      simp only [continuous_linear_map.coe_sub', continuous_linear_map.map_add, pow_two,
        continuous_linear_map.add_apply, pi.smul_apply, smul_sub, smul_add, smul_smul, ← sub_sub,
        continuous_linear_map.coe_smul', pi.sub_apply, continuous_linear_map.map_smul, this]
    end
    ... ≤ ‖f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)‖ * ‖h • w‖ :
      continuous_linear_map.le_op_norm _ _
    ... ≤ (ε * ‖h • v + (t * h) • w‖) * (‖h • w‖) :
    begin
      apply mul_le_mul_of_nonneg_right _ (norm_nonneg _),
      have H : x + h • v + (t * h) • w ∈ metric.ball x δ ∩ interior s,
      { refine ⟨_, xt_mem t ⟨ht.1, ht.2.le⟩⟩,
        rw [add_assoc, add_mem_ball_iff_norm],
        exact I.trans_lt hδ },
      simpa only [mem_set_of_eq, add_assoc x, add_sub_cancel'] using sδ H,
    end
    ... ≤ (ε * (‖h • v‖ + ‖h • w‖)) * (‖h • w‖) :
    begin
      apply mul_le_mul_of_nonneg_right _ (norm_nonneg _),
      apply mul_le_mul_of_nonneg_left _ (εpos.le),
      apply (norm_add_le _ _).trans,
      refine add_le_add le_rfl _,
      simp only [norm_smul, real.norm_eq_abs, abs_mul, abs_of_nonneg, ht.1, hpos.le, mul_assoc],
      exact mul_le_of_le_one_left (mul_nonneg hpos.le (norm_nonneg _)) ht.2.le,
    end
    ... = ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2 :
      by { simp only [norm_smul, real.norm_eq_abs, abs_mul, abs_of_nonneg, hpos.le], ring } },
  -- conclude using the mean value inequality
  have I : ‖g 1 - g 0‖ ≤ ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2, by simpa only [mul_one, sub_zero] using
    norm_image_sub_le_of_norm_deriv_le_segment' g_deriv g'_bound 1 (right_mem_Icc.2 zero_le_one),
  convert I using 1,
  { congr' 1,
    dsimp only [g],
    simp only [nat.one_ne_zero, add_zero, one_mul, zero_div, zero_mul, sub_zero, zero_smul,
      ne.def, not_false_iff, bit0_eq_zero, zero_pow'],
    abel },
  { simp only [real.norm_eq_abs, abs_mul, add_nonneg (norm_nonneg v) (norm_nonneg w),
      abs_of_nonneg, mul_assoc, pow_bit0_abs, norm_nonneg, abs_pow] }
end

/-- One can get `f'' v w` as the limit of `h ^ (-2)` times the alternate sum of the values of `f`
along the vertices of a quadrilateral with sides `h v` and `h w` based at `x`.
In a setting where `f` is not guaranteed to be continuous at `f`, we can still
get this if we use a quadrilateral based at `h v + h w`. -/
lemma convex.is_o_alternate_sum_square
  {v w : E} (h4v : x + (4 : ℝ) • v ∈ interior s) (h4w : x + (4 : ℝ) • w ∈ interior s) :
  (λ h : ℝ, f (x + h • (2 • v + 2 • w)) + f (x + h • (v + w))
    - f (x + h • (2 • v + w)) - f (x + h • (v + 2 • w)) - h^2 • f'' v w) =o[𝓝[>] 0] (λ h, h^2) :=
begin
  have A : (1 : ℝ)/2 ∈ Ioc (0 : ℝ) 1 := ⟨by norm_num, by norm_num⟩,
  have B : (1 : ℝ)/2 ∈ Icc (0 : ℝ) 1 := ⟨by norm_num, by norm_num⟩,
  have C : ∀ (w : E), (2 : ℝ) • w = 2 • w := λ w, by simp only [two_smul],
  have h2v2w : x + (2 : ℝ) • v + (2 : ℝ) • w ∈ interior s,
  { convert s_conv.interior.add_smul_sub_mem h4v h4w B using 1,
    simp only [smul_sub, smul_smul, one_div, add_sub_add_left_eq_sub, mul_add, add_smul],
    norm_num,
    simp only [show (4 : ℝ) = (2 : ℝ) + (2 : ℝ), by norm_num, add_smul],
    abel },
  have h2vww : x + (2 • v + w) + w ∈ interior s,
  { convert h2v2w using 1,
    simp only [two_smul],
    abel },
  have h2v : x + (2 : ℝ) • v ∈ interior s,
  { convert s_conv.add_smul_sub_mem_interior xs h4v A using 1,
    simp only [smul_smul, one_div, add_sub_cancel', add_right_inj],
    norm_num },
  have h2w : x + (2 : ℝ) • w ∈ interior s,
  { convert s_conv.add_smul_sub_mem_interior xs h4w A using 1,
    simp only [smul_smul, one_div, add_sub_cancel', add_right_inj],
    norm_num },
  have hvw : x + (v + w) ∈ interior s,
  { convert s_conv.add_smul_sub_mem_interior xs h2v2w A using 1,
    simp only [smul_smul, one_div, add_sub_cancel', add_right_inj, smul_add, smul_sub],
    norm_num,
    abel },
  have h2vw : x + (2 • v + w) ∈ interior s,
  { convert s_conv.interior.add_smul_sub_mem h2v h2v2w B using 1,
    simp only [smul_add, smul_sub, smul_smul, ← C],
    norm_num,
    abel },
  have hvww : x + (v + w) + w ∈ interior s,
  { convert s_conv.interior.add_smul_sub_mem h2w h2v2w B using 1,
    simp only [one_div, add_sub_cancel', inv_smul_smul₀, add_sub_add_right_eq_sub, ne.def,
      not_false_iff, bit0_eq_zero, one_ne_zero],
    rw two_smul,
    abel },
  have TA1 := s_conv.taylor_approx_two_segment hf xs hx h2vw h2vww,
  have TA2 := s_conv.taylor_approx_two_segment hf xs hx hvw hvww,
  convert TA1.sub TA2,
  ext h,
  simp only [two_smul, smul_add, ← add_assoc, continuous_linear_map.map_add,
    continuous_linear_map.add_apply, pi.smul_apply,
    continuous_linear_map.coe_smul', continuous_linear_map.map_smul],
  abel,
end

/-- Assume that `f` is differentiable inside a convex set `s`, and that its derivative `f'` is
differentiable at a point `x`. Then, given two vectors `v` and `w` pointing inside `s`, one
has `f'' v w = f'' w v`. Superseded by `convex.second_derivative_within_at_symmetric`, which
removes the assumption that `v` and `w` point inside `s`.
-/
lemma convex.second_derivative_within_at_symmetric_of_mem_interior
  {v w : E} (h4v : x + (4 : ℝ) • v ∈ interior s) (h4w : x + (4 : ℝ) • w ∈ interior s) :
  f'' w v = f'' v w :=
begin
  have A : (λ h : ℝ, h^2 • (f'' w v- f'' v w)) =o[𝓝[>] 0] (λ h, h^2),
  { convert (s_conv.is_o_alternate_sum_square hf xs hx h4v h4w).sub
            (s_conv.is_o_alternate_sum_square hf xs hx h4w h4v),
    ext h,
    simp only [add_comm, smul_add, smul_sub],
    abel },
  have B : (λ h : ℝ, f'' w v - f'' v w) =o[𝓝[>] 0] (λ h, (1 : ℝ)),
  { have : (λ h : ℝ, 1/h^2) =O[𝓝[>] 0] (λ h, 1/h^2) := is_O_refl _ _,
    have C := this.smul_is_o A,
    apply C.congr' _ _,
    { filter_upwards [self_mem_nhds_within],
      assume h hpos,
      rw [← one_smul ℝ (f'' w v - f'' v w), smul_smul, smul_smul],
      congr' 1,
      field_simp [has_lt.lt.ne' hpos] },
    { filter_upwards [self_mem_nhds_within] with _ hpos,
      field_simp [has_lt.lt.ne' hpos, has_smul.smul], }, },
  simpa only [sub_eq_zero] using is_o_const_const_iff.1 B,
end

omit s_conv xs hx hf

/-- If a function is differentiable inside a convex set with nonempty interior, and has a second
derivative at a point of this convex set, then this second derivative is symmetric. -/
theorem convex.second_derivative_within_at_symmetric
  {s : set E} (s_conv : convex ℝ s) (hne : (interior s).nonempty)
  {f : E → F} {f' : E → (E →L[ℝ] F)} {f'' : E →L[ℝ] (E →L[ℝ] F)}
  (hf : ∀ x ∈ interior s, has_fderiv_at f (f' x) x)
  {x : E} (xs : x ∈ s) (hx : has_fderiv_within_at f' f'' (interior s) x) (v w : E) :
  f'' v w = f'' w v :=
begin
  /- we work around a point `x + 4 z` in the interior of `s`. For any vector `m`,
  then `x + 4 (z + t m)` also belongs to the interior of `s` for small enough `t`. This means that
  we will be able to apply `second_derivative_within_at_symmetric_of_mem_interior` to show
  that `f''` is symmetric, after cancelling all the contributions due to `z`. -/
  rcases hne with ⟨y, hy⟩,
  obtain ⟨z, hz⟩ : ∃ z, z = ((1:ℝ) / 4) • (y - x) := ⟨((1:ℝ) / 4) • (y - x), rfl⟩,
  have A : ∀ (m : E), filter.tendsto (λ (t : ℝ), x + (4 : ℝ) • (z + t • m)) (𝓝 0) (𝓝 y),
  { assume m,
    have : x + (4 : ℝ) • (z + (0 : ℝ) • m) = y, by simp [hz],
    rw ← this,
    refine tendsto_const_nhds.add _,
    refine tendsto_const_nhds.smul _,
    refine tendsto_const_nhds.add _,
    exact continuous_at_id.smul continuous_at_const },
  have B : ∀ (m : E), ∀ᶠ t in 𝓝[>] (0 : ℝ), x + (4 : ℝ) • (z + t • m) ∈ interior s,
  { assume m,
    apply nhds_within_le_nhds,
    apply A m,
    rw [mem_interior_iff_mem_nhds] at hy,
    exact interior_mem_nhds.2 hy },
  -- we choose `t m > 0` such that `x + 4 (z + (t m) m)` belongs to the interior of `s`, for any
  -- vector `m`.
  choose t ts tpos using λ m, ((B m).and self_mem_nhds_within).exists,
  -- applying `second_derivative_within_at_symmetric_of_mem_interior` to the vectors `z`
  -- and `z + (t m) m`, we deduce that `f'' m z = f'' z m` for all `m`.
  have C : ∀ (m : E), f'' m z = f'' z m,
  { assume m,
    have : f'' (z + t m • m) (z + t 0 • 0) = f'' (z + t 0 • 0) (z + t m • m) :=
      s_conv.second_derivative_within_at_symmetric_of_mem_interior hf xs hx (ts 0) (ts m),
    simp only [continuous_linear_map.map_add, continuous_linear_map.map_smul, add_right_inj,
      continuous_linear_map.add_apply, pi.smul_apply, continuous_linear_map.coe_smul', add_zero,
      continuous_linear_map.zero_apply, smul_zero, continuous_linear_map.map_zero] at this,
    exact smul_right_injective F (tpos m).ne' this },
  -- applying `second_derivative_within_at_symmetric_of_mem_interior` to the vectors `z + (t v) v`
  -- and `z + (t w) w`, we deduce that `f'' v w = f'' w v`. Cross terms involving `z` can be
  -- eliminated thanks to the fact proved above that `f'' m z = f'' z m`.
  have : f'' (z + t v • v) (z + t w • w) = f'' (z + t w • w) (z + t v • v) :=
    s_conv.second_derivative_within_at_symmetric_of_mem_interior hf xs hx (ts w) (ts v),
  simp only [continuous_linear_map.map_add, continuous_linear_map.map_smul, smul_add, smul_smul,
    continuous_linear_map.add_apply, pi.smul_apply, continuous_linear_map.coe_smul', C] at this,
  rw ← sub_eq_zero at this,
  abel at this,
  simp only [one_zsmul, neg_smul, sub_eq_zero, mul_comm, ← sub_eq_add_neg] at this,
  apply smul_right_injective F _ this,
  simp [(tpos v).ne', (tpos w).ne']
end

/-- If a function is differentiable around `x`, and has two derivatives at `x`, then the second
derivative is symmetric. -/
theorem second_derivative_symmetric_of_eventually
  {f : E → F} {f' : E → (E →L[ℝ] F)} {f'' : E →L[ℝ] (E →L[ℝ] F)}
  (hf : ∀ᶠ y in 𝓝 x, has_fderiv_at f (f' y) y)
  (hx : has_fderiv_at f' f'' x) (v w : E) :
  f'' v w = f'' w v :=
begin
  rcases metric.mem_nhds_iff.1 hf with ⟨ε, εpos, hε⟩,
  have A : (interior (metric.ball x ε)).nonempty,
    by rwa [metric.is_open_ball.interior_eq, metric.nonempty_ball],
  exact convex.second_derivative_within_at_symmetric (convex_ball x ε) A
    (λ y hy, hε (interior_subset hy)) (metric.mem_ball_self εpos) hx.has_fderiv_within_at v w,
end

/-- If a function is differentiable, and has two derivatives at `x`, then the second
derivative is symmetric. -/
theorem second_derivative_symmetric
  {f : E → F} {f' : E → (E →L[ℝ] F)} {f'' : E →L[ℝ] (E →L[ℝ] F)}
  (hf : ∀ y, has_fderiv_at f (f' y) y)
  (hx : has_fderiv_at f' f'' x) (v w : E) :
  f'' v w = f'' w v :=
second_derivative_symmetric_of_eventually (filter.eventually_of_forall hf) hx v w


/-
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, Jeremy Avigad, Yury Kudryashov
-/
import order.filter.at_top_bot
import order.filter.pi

/-!
# The cofinite filter

In this file we define

`cofinite`: the filter of sets with finite complement

and prove its basic properties. In particular, we prove that for `ℕ` it is equal to `at_top`.

## TODO

Define filters for other cardinalities of the complement.
-/

open set function
open_locale classical

variables {ι α β : Type*}

namespace filter

/-- The cofinite filter is the filter of subsets whose complements are finite. -/
def cofinite : filter α :=
{ sets             := {s | sᶜ.finite},
  univ_sets        := by simp only [compl_univ, finite_empty, mem_set_of_eq],
  sets_of_superset := assume s t (hs : sᶜ.finite) (st: s ⊆ t),
    hs.subset $ compl_subset_compl.2 st,
  inter_sets       := assume s t (hs : sᶜ.finite) (ht : tᶜ.finite),
    by simp only [compl_inter, finite.union, ht, hs, mem_set_of_eq] }

@[simp] lemma mem_cofinite {s : set α} : s ∈ (@cofinite α) ↔ sᶜ.finite := iff.rfl

@[simp] lemma eventually_cofinite {p : α → Prop} :
  (∀ᶠ x in cofinite, p x) ↔ {x | ¬p x}.finite := iff.rfl

lemma has_basis_cofinite : has_basis cofinite (λ s : set α, s.finite) compl :=
⟨λ s, ⟨λ h, ⟨sᶜ, h, (compl_compl s).subset⟩, λ ⟨t, htf, hts⟩, htf.subset $ compl_subset_comm.2 hts⟩⟩

instance cofinite_ne_bot [infinite α] : ne_bot (@cofinite α) :=
has_basis_cofinite.ne_bot_iff.2 $ λ s hs, hs.infinite_compl.nonempty

lemma frequently_cofinite_iff_infinite {p : α → Prop} :
  (∃ᶠ x in cofinite, p x) ↔ set.infinite {x | p x} :=
by simp only [filter.frequently, filter.eventually, mem_cofinite, compl_set_of, not_not,
  set.infinite]

lemma _root_.set.finite.compl_mem_cofinite {s : set α} (hs : s.finite) : sᶜ ∈ (@cofinite α) :=
mem_cofinite.2 $ (compl_compl s).symm ▸ hs

lemma _root_.set.finite.eventually_cofinite_nmem {s : set α} (hs : s.finite) :
  ∀ᶠ x in cofinite, x ∉ s :=
hs.compl_mem_cofinite

lemma _root_.finset.eventually_cofinite_nmem (s : finset α) : ∀ᶠ x in cofinite, x ∉ s :=
s.finite_to_set.eventually_cofinite_nmem

lemma _root_.set.infinite_iff_frequently_cofinite {s : set α} :
  set.infinite s ↔ (∃ᶠ x in cofinite, x ∈ s) :=
frequently_cofinite_iff_infinite.symm

lemma eventually_cofinite_ne (x : α) : ∀ᶠ a in cofinite, a ≠ x :=
(set.finite_singleton x).eventually_cofinite_nmem

lemma le_cofinite_iff_compl_singleton_mem {l : filter α} :
  l ≤ cofinite ↔ ∀ x, {x}ᶜ ∈ l :=
begin
  refine ⟨λ h x, h (finite_singleton x).compl_mem_cofinite, λ h s (hs : sᶜ.finite), _⟩,
  rw [← compl_compl s, ← bUnion_of_singleton sᶜ, compl_Union₂,filter.bInter_mem hs],
  exact λ x _, h x
end

lemma le_cofinite_iff_eventually_ne {l : filter α} :
  l ≤ cofinite ↔ ∀ x, ∀ᶠ y in l, y ≠ x :=
le_cofinite_iff_compl_singleton_mem

/-- If `α` is a preorder with no maximal element, then `at_top ≤ cofinite`. -/
lemma at_top_le_cofinite [preorder α] [no_max_order α] : (at_top : filter α) ≤ cofinite :=
le_cofinite_iff_eventually_ne.mpr eventually_ne_at_top

lemma comap_cofinite_le (f : α → β) : comap f cofinite ≤ cofinite :=
le_cofinite_iff_eventually_ne.mpr $ λ x,
  mem_comap.2 ⟨{f x}ᶜ, (finite_singleton _).compl_mem_cofinite, λ y, ne_of_apply_ne f⟩

/-- The coproduct of the cofinite filters on two types is the cofinite filter on their product. -/
lemma coprod_cofinite : (cofinite : filter α).coprod (cofinite : filter β) = cofinite :=
filter.coext $ λ s, by simp only [compl_mem_coprod, mem_cofinite, compl_compl,
  finite_image_fst_and_snd_iff]

/-- Finite product of finite sets is finite -/
lemma Coprod_cofinite {α : ι → Type*} [fintype ι] :
  filter.Coprod (λ i, (cofinite : filter (α i))) = cofinite :=
filter.coext $ λ s, by simp only [compl_mem_Coprod, mem_cofinite, compl_compl,
  forall_finite_image_eval_iff]

end filter

open filter

/-- For natural numbers the filters `cofinite` and `at_top` coincide. -/
lemma nat.cofinite_eq_at_top : @cofinite ℕ = at_top :=
begin
  refine le_antisymm _ at_top_le_cofinite,
  refine at_top_basis.ge_iff.2 (λ N hN, _),
  simpa only [mem_cofinite, compl_Ici] using finite_lt_nat N
end

lemma nat.frequently_at_top_iff_infinite {p : ℕ → Prop} :
  (∃ᶠ n in at_top, p n) ↔ set.infinite {n | p n} :=
by rw [← nat.cofinite_eq_at_top, frequently_cofinite_iff_infinite]

lemma filter.tendsto.exists_within_forall_le {α β : Type*} [linear_order β] {s : set α}
  (hs : s.nonempty)
  {f : α → β} (hf : filter.tendsto f filter.cofinite filter.at_top) :
  ∃ a₀ ∈ s, ∀ a ∈ s, f a₀ ≤ f a :=
begin
  rcases em (∃ y ∈ s, ∃ x, f y < x) with ⟨y, hys, x, hx⟩|not_all_top,
  { -- the set of points `{y | f y < x}` is nonempty and finite, so we take `min` over this set
    have : {y | ¬x ≤ f y}.finite := (filter.eventually_cofinite.mp (tendsto_at_top.1 hf x)),
    simp only [not_le] at this,
    obtain ⟨a₀, ⟨ha₀ : f a₀ < x, ha₀s⟩, others_bigger⟩ :=
      exists_min_image _ f (this.inter_of_left s) ⟨y, hx, hys⟩,
    refine ⟨a₀, ha₀s, λ a has, (lt_or_le (f a) x).elim _ (le_trans ha₀.le)⟩,
    exact λ h, others_bigger a ⟨h, has⟩ },
  { -- in this case, f is constant because all values are at top
    push_neg at not_all_top,
    obtain ⟨a₀, ha₀s⟩ := hs,
    exact ⟨a₀, ha₀s, λ a ha, not_all_top a ha (f a₀)⟩ }
end

lemma filter.tendsto.exists_forall_le [nonempty α] [linear_order β] {f : α → β}
  (hf : tendsto f cofinite at_top) :
  ∃ a₀, ∀ a, f a₀ ≤ f a :=
let ⟨a₀, _, ha₀⟩ := hf.exists_within_forall_le univ_nonempty in ⟨a₀, λ a, ha₀ a (mem_univ _)⟩

lemma filter.tendsto.exists_within_forall_ge [linear_order β] {s : set α} (hs : s.nonempty)
  {f : α → β} (hf : filter.tendsto f filter.cofinite filter.at_bot) :
  ∃ a₀ ∈ s, ∀ a ∈ s, f a ≤ f a₀ :=
@filter.tendsto.exists_within_forall_le _ βᵒᵈ _ _ hs _ hf

lemma filter.tendsto.exists_forall_ge [nonempty α] [linear_order β] {f : α → β}
  (hf : tendsto f cofinite at_bot) :
  ∃ a₀, ∀ a, f a ≤ f a₀ :=
@filter.tendsto.exists_forall_le _ βᵒᵈ _ _ _ hf

/-- For an injective function `f`, inverse images of finite sets are finite. See also
`filter.comap_cofinite_le` and `function.injective.comap_cofinite_eq`. -/
lemma function.injective.tendsto_cofinite {f : α → β} (hf : injective f) :
  tendsto f cofinite cofinite :=
λ s h, h.preimage (hf.inj_on _)

/-- The pullback of the `filter.cofinite` under an injective function is equal to `filter.cofinite`.
See also `filter.comap_cofinite_le` and `function.injective.tendsto_cofinite`. -/
lemma function.injective.comap_cofinite_eq {f : α → β} (hf : injective f) :
  comap f cofinite = cofinite :=
(comap_cofinite_le f).antisymm hf.tendsto_cofinite.le_comap

/-- An injective sequence `f : ℕ → ℕ` tends to infinity at infinity. -/
lemma function.injective.nat_tendsto_at_top {f : ℕ → ℕ} (hf : injective f) :
  tendsto f at_top at_top :=
nat.cofinite_eq_at_top ▸ hf.tendsto_cofinite


/-
Copyright (c) 2020 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 data.finset.sort
import algebra.big_operators.order
import algebra.big_operators.fin

/-!
# Compositions

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

A composition of a natural number `n` is a decomposition `n = i₀ + ... + i_{k-1}` of `n` into a sum
of positive integers. Combinatorially, it corresponds to a decomposition of `{0, ..., n-1}` into
non-empty blocks of consecutive integers, where the `iⱼ` are the lengths of the blocks.
This notion is closely related to that of a partition of `n`, but in a composition of `n` the
order of the `iⱼ`s matters.

We implement two different structures covering these two viewpoints on compositions. The first
one, made of a list of positive integers summing to `n`, is the main one and is called
`composition n`. The second one is useful for combinatorial arguments (for instance to show that
the number of compositions of `n` is `2^(n-1)`). It is given by a subset of `{0, ..., n}`
containing `0` and `n`, where the elements of the subset (other than `n`) correspond to the leftmost
points of each block. The main API is built on `composition n`, and we provide an equivalence
between the two types.

## Main functions

* `c : composition n` is a structure, made of a list of integers which are all positive and
  add up to `n`.
* `composition_card` states that the cardinality of `composition n` is exactly
  `2^(n-1)`, which is proved by constructing an equiv with `composition_as_set n` (see below), which
  is itself in bijection with the subsets of `fin (n-1)` (this holds even for `n = 0`, where `-` is
  nat subtraction).

Let `c : composition n` be a composition of `n`. Then
* `c.blocks` is the list of blocks in `c`.
* `c.length` is the number of blocks in the composition.
* `c.blocks_fun : fin c.length → ℕ` is the realization of `c.blocks` as a function on
  `fin c.length`. This is the main object when using compositions to understand the composition of
    analytic functions.
* `c.size_up_to : ℕ → ℕ` is the sum of the size of the blocks up to `i`.;
* `c.embedding i : fin (c.blocks_fun i) → fin n` is the increasing embedding of the `i`-th block in
  `fin n`;
* `c.index j`, for `j : fin n`, is the index of the block containing `j`.

* `composition.ones n` is the composition of `n` made of ones, i.e., `[1, ..., 1]`.
* `composition.single n (hn : 0 < n)` is the composition of `n` made of a single block of size `n`.

Compositions can also be used to split lists. Let `l` be a list of length `n` and `c` a composition
of `n`.
* `l.split_wrt_composition c` is a list of lists, made of the slices of `l` corresponding to the
  blocks of `c`.
* `join_split_wrt_composition` states that splitting a list and then joining it gives back the
  original list.
* `split_wrt_composition_join` states that joining a list of lists, and then splitting it back
  according to the right composition, gives back the original list of lists.

We turn to the second viewpoint on compositions, that we realize as a finset of `fin (n+1)`.
`c : composition_as_set n` is a structure made of a finset of `fin (n+1)` called `c.boundaries`
and proofs that it contains `0` and `n`. (Taking a finset of `fin n` containing `0` would not
make sense in the edge case `n = 0`, while the previous description works in all cases).
The elements of this set (other than `n`) correspond to leftmost points of blocks.
Thus, there is an equiv between `composition n` and `composition_as_set n`. We
only construct basic API on `composition_as_set` (notably `c.length` and `c.blocks`) to be able
to construct this equiv, called `composition_equiv n`. Since there is a straightforward equiv
between `composition_as_set n` and finsets of `{1, ..., n-1}` (obtained by removing `0` and `n`
from a `composition_as_set` and called `composition_as_set_equiv n`), we deduce that
`composition_as_set n` and `composition n` are both fintypes of cardinality `2^(n - 1)`
(see `composition_as_set_card` and `composition_card`).

## Implementation details

The main motivation for this structure and its API is in the construction of the composition of
formal multilinear series, and the proof that the composition of analytic functions is analytic.

The representation of a composition as a list is very handy as lists are very flexible and already
have a well-developed API.

## Tags

Composition, partition

## References

<https://en.wikipedia.org/wiki/Composition_(combinatorics)>
-/

open list
open_locale big_operators

variable {n : ℕ}

/-- A composition of `n` is a list of positive integers summing to `n`. -/
@[ext] structure composition (n : ℕ) :=
(blocks : list ℕ)
(blocks_pos : ∀ {i}, i ∈ blocks → 0 < i)
(blocks_sum : blocks.sum = n)

/-- Combinatorial viewpoint on a composition of `n`, by seeing it as non-empty blocks of
consecutive integers in `{0, ..., n-1}`. We register every block by its left end-point, yielding
a finset containing `0`. As this does not make sense for `n = 0`, we add `n` to this finset, and
get a finset of `{0, ..., n}` containing `0` and `n`. This is the data in the structure
`composition_as_set n`. -/
@[ext] structure composition_as_set (n : ℕ) :=
(boundaries : finset (fin n.succ))
(zero_mem   : (0 : fin n.succ) ∈ boundaries)
(last_mem   : fin.last n ∈ boundaries)

instance {n : ℕ} : inhabited (composition_as_set n) :=
⟨⟨finset.univ, finset.mem_univ _, finset.mem_univ _⟩⟩

/-!
### Compositions

A composition of an integer `n` is a decomposition `n = i₀ + ... + i_{k-1}` of `n` into a sum of
positive integers.
-/

namespace composition

variables (c : composition n)

instance (n : ℕ) : has_to_string (composition n) :=
⟨λ c, to_string c.blocks⟩

/-- The length of a composition, i.e., the number of blocks in the composition. -/
@[reducible] def length : ℕ := c.blocks.length

lemma blocks_length : c.blocks.length = c.length := rfl

/-- The blocks of a composition, seen as a function on `fin c.length`. When composing analytic
functions using compositions, this is the main player. -/
def blocks_fun : fin c.length → ℕ := λ i, nth_le c.blocks i i.2

lemma of_fn_blocks_fun : of_fn c.blocks_fun = c.blocks :=
of_fn_nth_le _

lemma sum_blocks_fun : ∑ i, c.blocks_fun i = n :=
by conv_rhs { rw [← c.blocks_sum, ← of_fn_blocks_fun, sum_of_fn] }

lemma blocks_fun_mem_blocks (i : fin c.length) : c.blocks_fun i ∈ c.blocks :=
nth_le_mem _ _ _

@[simp] lemma one_le_blocks {i : ℕ} (h : i ∈ c.blocks) : 1 ≤ i :=
c.blocks_pos h

@[simp] lemma one_le_blocks' {i : ℕ} (h : i < c.length) : 1 ≤ nth_le c.blocks i h:=
c.one_le_blocks (nth_le_mem (blocks c) i h)

@[simp] lemma blocks_pos' (i : ℕ) (h : i < c.length) : 0 < nth_le c.blocks i h:=
c.one_le_blocks' h

lemma one_le_blocks_fun (i : fin c.length) : 1 ≤ c.blocks_fun i :=
c.one_le_blocks (c.blocks_fun_mem_blocks i)

lemma length_le : c.length ≤ n :=
begin
  conv_rhs { rw ← c.blocks_sum },
  exact length_le_sum_of_one_le _ (λ i hi, c.one_le_blocks hi)
end

lemma length_pos_of_pos (h : 0 < n) : 0 < c.length :=
begin
  apply length_pos_of_sum_pos,
  convert h,
  exact c.blocks_sum
end

/-- The sum of the sizes of the blocks in a composition up to `i`. -/
def size_up_to (i : ℕ) : ℕ := (c.blocks.take i).sum

@[simp] lemma size_up_to_zero : c.size_up_to 0 = 0 := by simp [size_up_to]

lemma size_up_to_of_length_le (i : ℕ) (h : c.length ≤ i) : c.size_up_to i = n :=
begin
  dsimp [size_up_to],
  convert c.blocks_sum,
  exact take_all_of_le h
end

@[simp] lemma size_up_to_length : c.size_up_to c.length = n :=
c.size_up_to_of_length_le c.length le_rfl

lemma size_up_to_le (i : ℕ) : c.size_up_to i ≤ n :=
begin
  conv_rhs { rw [← c.blocks_sum, ← sum_take_add_sum_drop _ i] },
  exact nat.le_add_right _ _
end

lemma size_up_to_succ {i : ℕ} (h : i < c.length) :
  c.size_up_to (i+1) = c.size_up_to i + c.blocks.nth_le i h :=
by { simp only [size_up_to], rw sum_take_succ _ _ h }

lemma size_up_to_succ' (i : fin c.length) :
  c.size_up_to ((i : ℕ) + 1) = c.size_up_to i + c.blocks_fun i :=
c.size_up_to_succ i.2

lemma size_up_to_strict_mono {i : ℕ} (h : i < c.length) : c.size_up_to i < c.size_up_to (i+1) :=
by { rw c.size_up_to_succ h, simp }

lemma monotone_size_up_to : monotone c.size_up_to :=
monotone_sum_take _

/-- The `i`-th boundary of a composition, i.e., the leftmost point of the `i`-th block. We include
a virtual point at the right of the last block, to make for a nice equiv with
`composition_as_set n`. -/
def boundary : fin (c.length + 1) ↪o fin (n+1) :=
order_embedding.of_strict_mono (λ i, ⟨c.size_up_to i, nat.lt_succ_of_le (c.size_up_to_le i)⟩) $
 fin.strict_mono_iff_lt_succ.2 $ λ ⟨i, hi⟩, c.size_up_to_strict_mono hi

@[simp] lemma boundary_zero : c.boundary 0 = 0 :=
by simp [boundary, fin.ext_iff]

@[simp] lemma boundary_last : c.boundary (fin.last c.length) = fin.last n :=
by simp [boundary, fin.ext_iff]

/-- The boundaries of a composition, i.e., the leftmost point of all the blocks. We include
a virtual point at the right of the last block, to make for a nice equiv with
`composition_as_set n`. -/
def boundaries : finset (fin (n+1)) :=
finset.univ.map c.boundary.to_embedding

lemma card_boundaries_eq_succ_length : c.boundaries.card = c.length + 1 :=
by simp [boundaries]

/-- To `c : composition n`, one can associate a `composition_as_set n` by registering the leftmost
point of each block, and adding a virtual point at the right of the last block. -/
def to_composition_as_set : composition_as_set n :=
{ boundaries := c.boundaries,
  zero_mem := begin
    simp only [boundaries, finset.mem_univ, exists_prop_of_true, finset.mem_map],
    exact ⟨0, rfl⟩,
  end,
  last_mem := begin
    simp only [boundaries, finset.mem_univ, exists_prop_of_true, finset.mem_map],
    exact ⟨fin.last c.length, c.boundary_last⟩,
  end }

/-- The canonical increasing bijection between `fin (c.length + 1)` and `c.boundaries` is
exactly `c.boundary`. -/
lemma order_emb_of_fin_boundaries :
  c.boundaries.order_emb_of_fin c.card_boundaries_eq_succ_length = c.boundary :=
begin
  refine (finset.order_emb_of_fin_unique' _ _).symm,
  exact λ i, (finset.mem_map' _).2 (finset.mem_univ _)
end

/-- Embedding the `i`-th block of a composition (identified with `fin (c.blocks_fun i)`) into
`fin n` at the relevant position. -/
def embedding (i : fin c.length) : fin (c.blocks_fun i) ↪o fin n :=
(fin.nat_add $ c.size_up_to i).trans $ fin.cast_le $
calc c.size_up_to i + c.blocks_fun i = c.size_up_to (i + 1) : (c.size_up_to_succ _).symm
... ≤ c.size_up_to c.length : monotone_sum_take _ i.2
... = n : c.size_up_to_length

@[simp] lemma coe_embedding (i : fin c.length) (j : fin (c.blocks_fun i)) :
  (c.embedding i j : ℕ) = c.size_up_to i + j := rfl

/--
`index_exists` asserts there is some `i` with `j < c.size_up_to (i+1)`.
In the next definition `index` we use `nat.find` to produce the minimal such index.
-/
lemma index_exists {j : ℕ} (h : j < n) :
  ∃ i : ℕ, j < c.size_up_to i.succ ∧ i < c.length :=
begin
  have n_pos : 0 < n := lt_of_le_of_lt (zero_le j) h,
  have : 0 < c.blocks.sum, by rwa [← c.blocks_sum] at n_pos,
  have length_pos : 0 < c.blocks.length := length_pos_of_sum_pos (blocks c) this,
  refine ⟨c.length.pred, _, nat.pred_lt (ne_of_gt length_pos)⟩,
  have : c.length.pred.succ = c.length := nat.succ_pred_eq_of_pos length_pos,
  simp [this, h]
end

/-- `c.index j` is the index of the block in the composition `c` containing `j`. -/
def index (j : fin n) : fin c.length :=
⟨nat.find (c.index_exists j.2), (nat.find_spec (c.index_exists j.2)).2⟩

lemma lt_size_up_to_index_succ (j : fin n) : (j : ℕ) < c.size_up_to (c.index j).succ :=
(nat.find_spec (c.index_exists j.2)).1

lemma size_up_to_index_le (j : fin n) : c.size_up_to (c.index j) ≤ j :=
begin
  by_contradiction H,
  set i := c.index j with hi,
  push_neg at H,
  have i_pos : (0 : ℕ) < i,
  { by_contra' i_pos,
    revert H, simp [nonpos_iff_eq_zero.1 i_pos, c.size_up_to_zero] },
  let i₁ := (i : ℕ).pred,
  have i₁_lt_i : i₁ < i := nat.pred_lt (ne_of_gt i_pos),
  have i₁_succ : i₁.succ = i := nat.succ_pred_eq_of_pos i_pos,
  have := nat.find_min (c.index_exists j.2) i₁_lt_i,
  simp [lt_trans i₁_lt_i (c.index j).2, i₁_succ] at this,
  exact nat.lt_le_antisymm H this
end

/-- Mapping an element `j` of `fin n` to the element in the block containing it, identified with
`fin (c.blocks_fun (c.index j))` through the canonical increasing bijection. -/
def inv_embedding (j : fin n) : fin (c.blocks_fun (c.index j)) :=
⟨j - c.size_up_to (c.index j),
begin
  rw [tsub_lt_iff_right, add_comm, ← size_up_to_succ'],
  { exact lt_size_up_to_index_succ _ _ },
  { exact size_up_to_index_le _ _ }
end⟩

@[simp] lemma coe_inv_embedding (j : fin n) :
  (c.inv_embedding j : ℕ) = j - c.size_up_to (c.index j) := rfl

lemma embedding_comp_inv (j : fin n) :
  c.embedding (c.index j) (c.inv_embedding j) = j :=
begin
  rw fin.ext_iff,
  apply add_tsub_cancel_of_le (c.size_up_to_index_le j),
end

lemma mem_range_embedding_iff {j : fin n} {i : fin c.length} :
  j ∈ set.range (c.embedding i) ↔
  c.size_up_to i ≤ j ∧ (j : ℕ) < c.size_up_to (i : ℕ).succ :=
begin
  split,
  { assume h,
    rcases set.mem_range.2 h with ⟨k, hk⟩,
    rw fin.ext_iff at hk,
    change c.size_up_to i + k = (j : ℕ) at hk,
    rw ← hk,
    simp [size_up_to_succ', k.is_lt] },
  { assume h,
    apply set.mem_range.2,
    refine ⟨⟨j - c.size_up_to i, _⟩, _⟩,
    { rw [tsub_lt_iff_left, ← size_up_to_succ'],
      { exact h.2 },
      { exact h.1 } },
    { rw fin.ext_iff,
      exact add_tsub_cancel_of_le h.1 } }
end

/-- The embeddings of different blocks of a composition are disjoint. -/
lemma disjoint_range {i₁ i₂ : fin c.length} (h : i₁ ≠ i₂) :
  disjoint (set.range (c.embedding i₁)) (set.range (c.embedding i₂)) :=
begin
  classical,
  wlog h' : i₁ < i₂, { exact (this c h.symm (h.lt_or_lt.resolve_left h')).symm },
  by_contradiction d,
  obtain ⟨x, hx₁, hx₂⟩ :
    ∃ x : fin n, (x ∈ set.range (c.embedding i₁) ∧ x ∈ set.range (c.embedding i₂)) :=
  set.not_disjoint_iff.1 d,
  have A : (i₁ : ℕ).succ ≤ i₂ := nat.succ_le_of_lt h',
  apply lt_irrefl (x : ℕ),
  calc (x : ℕ) < c.size_up_to (i₁ : ℕ).succ : (c.mem_range_embedding_iff.1 hx₁).2
  ... ≤ c.size_up_to (i₂ : ℕ) : monotone_sum_take _ A
  ... ≤ x : (c.mem_range_embedding_iff.1 hx₂).1
end

lemma mem_range_embedding (j : fin n) :
  j ∈ set.range (c.embedding (c.index j)) :=
begin
  have : c.embedding (c.index j) (c.inv_embedding j)
    ∈ set.range (c.embedding (c.index j)) := set.mem_range_self _,
  rwa c.embedding_comp_inv j at this
end

lemma mem_range_embedding_iff' {j : fin n} {i : fin c.length} :
  j ∈ set.range (c.embedding i) ↔ i = c.index j :=
begin
  split,
  { rw ← not_imp_not,
    assume h,
    exact set.disjoint_right.1 (c.disjoint_range h) (c.mem_range_embedding j) },
  { assume h,
    rw h,
    exact c.mem_range_embedding j }
end

lemma index_embedding (i : fin c.length) (j : fin (c.blocks_fun i)) :
  c.index (c.embedding i j) = i :=
begin
  symmetry,
  rw ← mem_range_embedding_iff',
  apply set.mem_range_self
end

lemma inv_embedding_comp (i : fin c.length) (j : fin (c.blocks_fun i)) :
  (c.inv_embedding (c.embedding i j) : ℕ) = j :=
by simp_rw [coe_inv_embedding, index_embedding, coe_embedding, add_tsub_cancel_left]

/-- Equivalence between the disjoint union of the blocks (each of them seen as
`fin (c.blocks_fun i)`) with `fin n`. -/
def blocks_fin_equiv : (Σ i : fin c.length, fin (c.blocks_fun i)) ≃ fin n :=
{ to_fun := λ x, c.embedding x.1 x.2,
  inv_fun := λ j, ⟨c.index j, c.inv_embedding j⟩,
  left_inv := λ x, begin
    rcases x with ⟨i, y⟩,
    dsimp,
    congr, { exact c.index_embedding _ _ },
    rw fin.heq_ext_iff,
    { exact c.inv_embedding_comp _ _ },
    { rw c.index_embedding }
  end,
  right_inv := λ j, c.embedding_comp_inv j }

lemma blocks_fun_congr {n₁ n₂ : ℕ} (c₁ : composition n₁) (c₂ : composition n₂)
  (i₁ : fin c₁.length) (i₂ : fin c₂.length) (hn : n₁ = n₂)
  (hc : c₁.blocks = c₂.blocks) (hi : (i₁ : ℕ) = i₂) :
  c₁.blocks_fun i₁ = c₂.blocks_fun i₂ :=
by { cases hn, rw ← composition.ext_iff at hc, cases hc, congr, rwa fin.ext_iff }

/-- Two compositions (possibly of different integers) coincide if and only if they have the
same sequence of blocks. -/
lemma sigma_eq_iff_blocks_eq {c : Σ n, composition n} {c' : Σ n, composition n} :
  c = c' ↔ c.2.blocks = c'.2.blocks :=
begin
  refine ⟨λ H, by rw H, λ H, _⟩,
  rcases c with ⟨n, c⟩,
  rcases c' with ⟨n', c'⟩,
  have : n = n', by { rw [← c.blocks_sum, ← c'.blocks_sum, H] },
  induction this,
  simp only [true_and, eq_self_iff_true, heq_iff_eq],
  ext1,
  exact H
end

/-! ### The composition `composition.ones` -/

/-- The composition made of blocks all of size `1`. -/
def ones (n : ℕ) : composition n :=
⟨replicate n (1 : ℕ), λ i hi, by simp [list.eq_of_mem_replicate hi], by simp⟩

instance {n : ℕ} : inhabited (composition n) :=
⟨composition.ones n⟩

@[simp] lemma ones_length (n : ℕ) : (ones n).length = n :=
list.length_replicate n 1

@[simp] lemma ones_blocks (n : ℕ) : (ones n).blocks = replicate n (1 : ℕ) := rfl

@[simp] lemma ones_blocks_fun (n : ℕ) (i : fin (ones n).length) :
  (ones n).blocks_fun i = 1 :=
by simp [blocks_fun, ones, blocks, i.2]

@[simp] lemma ones_size_up_to (n : ℕ) (i : ℕ) : (ones n).size_up_to i = min i n :=
by simp [size_up_to, ones_blocks, take_replicate]

@[simp] lemma ones_embedding (i : fin (ones n).length) (h : 0 < (ones n).blocks_fun i) :
  (ones n).embedding i ⟨0, h⟩ = ⟨i, lt_of_lt_of_le i.2 (ones n).length_le⟩ :=
by { ext, simpa using i.2.le }

lemma eq_ones_iff {c : composition n} :
  c = ones n ↔ ∀ i ∈ c.blocks, i = 1 :=
begin
  split,
  { rintro rfl,
    exact λ i, eq_of_mem_replicate },
  { assume H,
    ext1,
    have A : c.blocks = replicate c.blocks.length 1 := eq_replicate_of_mem H,
    have : c.blocks.length = n, by { conv_rhs { rw [← c.blocks_sum, A] }, simp },
    rw [A, this, ones_blocks] },
end

lemma ne_ones_iff {c : composition n} :
  c ≠ ones n ↔ ∃ i ∈ c.blocks, 1 < i :=
begin
  refine (not_congr eq_ones_iff).trans _,
  have : ∀ j ∈ c.blocks, j = 1 ↔ j ≤ 1 := λ j hj, by simp [le_antisymm_iff, c.one_le_blocks hj],
  simp [this] {contextual := tt}
end

lemma eq_ones_iff_length {c : composition n} :
  c = ones n ↔ c.length = n :=
begin
  split,
  { rintro rfl,
    exact ones_length n },
  { contrapose,
    assume H length_n,
    apply lt_irrefl n,
    calc
      n = ∑ (i : fin c.length), 1 : by simp [length_n]
      ... < ∑ (i : fin c.length), c.blocks_fun i :
      begin
        obtain ⟨i, hi, i_blocks⟩ : ∃ i ∈ c.blocks, 1 < i := ne_ones_iff.1 H,
        rw [← of_fn_blocks_fun, mem_of_fn c.blocks_fun, set.mem_range] at hi,
        obtain ⟨j : fin c.length, hj : c.blocks_fun j = i⟩ := hi,
        rw ← hj at i_blocks,
        exact finset.sum_lt_sum (λ i hi, by simp [blocks_fun]) ⟨j, finset.mem_univ _, i_blocks⟩,
      end
      ... = n : c.sum_blocks_fun }
end

lemma eq_ones_iff_le_length {c : composition n} :
  c = ones n ↔ n ≤ c.length :=
by simp [eq_ones_iff_length, le_antisymm_iff, c.length_le]

/-! ### The composition `composition.single` -/

/-- The composition made of a single block of size `n`. -/
def single (n : ℕ) (h : 0 < n) : composition n :=
⟨[n], by simp [h], by simp⟩

@[simp] lemma single_length {n : ℕ} (h : 0 < n) : (single n h).length = 1 := rfl

@[simp] lemma single_blocks {n : ℕ} (h : 0 < n) : (single n h).blocks = [n] := rfl

@[simp] lemma single_blocks_fun {n : ℕ} (h : 0 < n) (i : fin (single n h).length) :
  (single n h).blocks_fun i = n :=
by simp [blocks_fun, single, blocks, i.2]

@[simp] lemma single_embedding {n : ℕ} (h : 0 < n) (i : fin n) :
  (single n h).embedding ⟨0, single_length h ▸ zero_lt_one⟩ i = i :=
by { ext, simp }

lemma eq_single_iff_length {n : ℕ} (h : 0 < n) {c : composition n} :
  c = single n h ↔ c.length = 1 :=
begin
  split,
  { assume H,
    rw H,
    exact single_length h },
  { assume H,
    ext1,
    have A : c.blocks.length = 1 := H ▸ c.blocks_length,
    have B : c.blocks.sum = n := c.blocks_sum,
    rw eq_cons_of_length_one A at B ⊢,
    simpa [single_blocks] using B }
end

lemma ne_single_iff {n : ℕ} (hn : 0 < n) {c : composition n} :
  c ≠ single n hn ↔ ∀ i, c.blocks_fun i < n :=
begin
  rw ← not_iff_not,
  push_neg,
  split,
  { rintros rfl,
    exact ⟨⟨0, by simp⟩, by simp⟩ },
  { rintros ⟨i, hi⟩,
    rw eq_single_iff_length,
    have : ∀ j : fin c.length, j = i,
    { intros j,
      by_contradiction ji,
      apply lt_irrefl ∑ k, c.blocks_fun k,
      calc ∑ k, c.blocks_fun k ≤ c.blocks_fun i      : by simp only [c.sum_blocks_fun, hi]
                           ... < ∑ k, c.blocks_fun k :
        finset.single_lt_sum ji (finset.mem_univ _) (finset.mem_univ _) (c.one_le_blocks_fun j)
          (λ _ _ _, zero_le _) },
    simpa using fintype.card_eq_one_of_forall_eq this }
end

end composition

/-!
### Splitting a list

Given a list of length `n` and a composition `c` of `n`, one can split `l` into `c.length` sublists
of respective lengths `c.blocks_fun 0`, ..., `c.blocks_fun (c.length-1)`. This is inverse to the
join operation.
-/
namespace list
variable {α : Type*}

/-- Auxiliary for `list.split_wrt_composition`. -/
def split_wrt_composition_aux : list α → list ℕ → list (list α)
| l [] := []
| l (n :: ns) :=
  let (l₁, l₂) := l.split_at n in
  l₁ :: split_wrt_composition_aux l₂ ns

/-- Given a list of length `n` and a composition `[i₁, ..., iₖ]` of `n`, split `l` into a list of
`k` lists corresponding to the blocks of the composition, of respective lengths `i₁`, ..., `iₖ`.
This makes sense mostly when `n = l.length`, but this is not necessary for the definition. -/
def split_wrt_composition (l : list α) (c : composition n) : list (list α) :=
split_wrt_composition_aux l c.blocks

local attribute [simp] split_wrt_composition_aux.equations._eqn_1

local attribute [simp]
lemma split_wrt_composition_aux_cons (l : list α) (n ns) :
  l.split_wrt_composition_aux (n :: ns) = take n l :: (drop n l).split_wrt_composition_aux ns :=
by simp [split_wrt_composition_aux]

lemma length_split_wrt_composition_aux (l : list α) (ns) :
  length (l.split_wrt_composition_aux ns) = ns.length :=
by induction ns generalizing l; simp *

/-- When one splits a list along a composition `c`, the number of sublists thus created is
`c.length`. -/
@[simp] lemma length_split_wrt_composition (l : list α) (c : composition n) :
  length (l.split_wrt_composition c) = c.length :=
length_split_wrt_composition_aux _ _

lemma map_length_split_wrt_composition_aux {ns : list ℕ} :
  ∀ {l : list α}, ns.sum ≤ l.length → map length (l.split_wrt_composition_aux ns) = ns :=
begin
  induction ns with n ns IH; intros l h; simp at h ⊢,
  have := le_trans (nat.le_add_right _ _) h,
  rw IH, {simp [this]},
  rwa [length_drop, le_tsub_iff_left this]
end

/-- When one splits a list along a composition `c`, the lengths of the sublists thus created are
given by the block sizes in `c`. -/
lemma map_length_split_wrt_composition (l : list α) (c : composition l.length) :
  map length (l.split_wrt_composition c) = c.blocks :=
map_length_split_wrt_composition_aux (le_of_eq c.blocks_sum)

lemma length_pos_of_mem_split_wrt_composition {l l' : list α} {c : composition l.length}
  (h : l' ∈ l.split_wrt_composition c) : 0 < length l' :=
begin
  have : l'.length ∈ (l.split_wrt_composition c).map list.length :=
    list.mem_map_of_mem list.length h,
  rw map_length_split_wrt_composition at this,
  exact c.blocks_pos this
end

lemma sum_take_map_length_split_wrt_composition
  (l : list α) (c : composition l.length) (i : ℕ) :
  (((l.split_wrt_composition c).map length).take i).sum = c.size_up_to i :=
by { congr, exact map_length_split_wrt_composition l c }

lemma nth_le_split_wrt_composition_aux (l : list α) (ns : list ℕ) {i : ℕ} (hi) :
  nth_le (l.split_wrt_composition_aux ns) i hi =
  (l.take (ns.take (i+1)).sum).drop (ns.take i).sum :=
begin
  induction ns with n ns IH generalizing l i, {cases hi},
  cases i; simp [IH],
  rw [add_comm n, drop_add, drop_take],
end

/-- The `i`-th sublist in the splitting of a list `l` along a composition `c`, is the slice of `l`
between the indices `c.size_up_to i` and `c.size_up_to (i+1)`, i.e., the indices in the `i`-th
block of the composition. -/
lemma nth_le_split_wrt_composition (l : list α) (c : composition n)
  {i : ℕ} (hi : i < (l.split_wrt_composition c).length) :
  nth_le (l.split_wrt_composition c) i hi = (l.take (c.size_up_to (i+1))).drop (c.size_up_to i) :=
nth_le_split_wrt_composition_aux _ _ _

theorem join_split_wrt_composition_aux {ns : list ℕ} :
  ∀ {l : list α}, ns.sum = l.length → (l.split_wrt_composition_aux ns).join = l :=
begin
  induction ns with n ns IH; intros l h; simp at h ⊢,
  { exact (length_eq_zero.1 h.symm).symm },
  rw IH, {simp},
  rwa [length_drop, ← h, add_tsub_cancel_left]
end

/-- If one splits a list along a composition, and then joins the sublists, one gets back the
original list. -/
@[simp] theorem join_split_wrt_composition (l : list α) (c : composition l.length) :
  (l.split_wrt_composition c).join = l :=
join_split_wrt_composition_aux c.blocks_sum

/-- If one joins a list of lists and then splits the join along the right composition, one gets
back the original list of lists. -/
@[simp] theorem split_wrt_composition_join (L : list (list α)) (c : composition L.join.length)
  (h : map length L = c.blocks) : split_wrt_composition (join L) c = L :=
by simp only [eq_self_iff_true, and_self, eq_iff_join_eq, join_split_wrt_composition,
              map_length_split_wrt_composition, h]

end list

/-!
### Compositions as sets

Combinatorial viewpoints on compositions, seen as finite subsets of `fin (n+1)` containing `0` and
`n`, where the points of the set (other than `n`) correspond to the leftmost points of each block.
-/

/-- Bijection between compositions of `n` and subsets of `{0, ..., n-2}`, defined by
considering the restriction of the subset to `{1, ..., n-1}` and shifting to the left by one. -/
def composition_as_set_equiv (n : ℕ) : composition_as_set n ≃ finset (fin (n - 1)) :=
{ to_fun := λ c, {i : fin (n-1) |
    (⟨1 + (i : ℕ), begin
       apply (add_lt_add_left i.is_lt 1).trans_le,
       rw [nat.succ_eq_add_one, add_comm],
       exact add_le_add (nat.sub_le n 1) (le_refl 1)
    end ⟩ : fin n.succ) ∈ c.boundaries}.to_finset,
  inv_fun := λ s,
    { boundaries := {i : fin n.succ | (i = 0) ∨ (i = fin.last n)
        ∨ (∃ (j : fin (n-1)) (hj : j ∈ s), (i : ℕ) = j + 1)}.to_finset,
      zero_mem   := by simp,
      last_mem   := by simp },
  left_inv := begin
    assume c,
    ext i,
    simp only [exists_prop, add_comm, set.mem_to_finset, true_or, or_true, set.mem_set_of_eq],
    split,
    { rintro (rfl | rfl | ⟨j, hj1, hj2⟩),
      { exact c.zero_mem },
      { exact c.last_mem },
      { convert hj1, rwa fin.ext_iff } },
    { simp only [or_iff_not_imp_left],
      assume i_mem i_ne_zero i_ne_last,
      simp [fin.ext_iff] at i_ne_zero i_ne_last,
      have A : (1 + (i-1) : ℕ) = (i : ℕ),
        by { rw add_comm, exact nat.succ_pred_eq_of_pos (pos_iff_ne_zero.mpr i_ne_zero) },
      refine ⟨⟨i - 1, _⟩, _, _⟩,
      { have : (i : ℕ) < n + 1 := i.2,
        simp [nat.lt_succ_iff_lt_or_eq, i_ne_last] at this,
        exact nat.pred_lt_pred i_ne_zero this },
      { convert i_mem,
        rw fin.ext_iff,
        simp only [fin.coe_mk, A] },
      { simp [A] } },
  end,
  right_inv := begin
    assume s,
    ext i,
    have : 1 + (i : ℕ) ≠ n,
    { apply ne_of_lt,
      convert add_lt_add_left i.is_lt 1,
      rw add_comm,
      apply (nat.succ_pred_eq_of_pos _).symm,
      exact (zero_le i.val).trans_lt (i.2.trans_le (nat.sub_le n 1)) },
    simp only [fin.ext_iff, exists_prop, fin.coe_zero, add_comm,
      set.mem_to_finset, set.mem_set_of_eq, fin.coe_last],
    erw [set.mem_set_of_eq],
    simp only [this, false_or, add_right_inj, add_eq_zero_iff, one_ne_zero, false_and, fin.coe_mk],
    split,
    { rintros ⟨j, js, hj⟩, convert js, exact fin.ext_iff.2 hj },
    { assume h, exact ⟨i, h, rfl⟩ }
  end }

instance composition_as_set_fintype (n : ℕ) : fintype (composition_as_set n) :=
fintype.of_equiv _ (composition_as_set_equiv n).symm

lemma composition_as_set_card (n : ℕ) : fintype.card (composition_as_set n) = 2 ^ (n - 1) :=
begin
  have : fintype.card (finset (fin (n-1))) = 2 ^ (n - 1), by simp,
  rw ← this,
  exact fintype.card_congr (composition_as_set_equiv n)
end

namespace composition_as_set

variables (c : composition_as_set n)

lemma boundaries_nonempty : c.boundaries.nonempty :=
⟨0, c.zero_mem⟩

lemma card_boundaries_pos : 0 < finset.card c.boundaries :=
finset.card_pos.mpr c.boundaries_nonempty

/-- Number of blocks in a `composition_as_set`. -/
def length : ℕ := finset.card c.boundaries - 1

lemma card_boundaries_eq_succ_length : c.boundaries.card = c.length + 1 :=
(tsub_eq_iff_eq_add_of_le (nat.succ_le_of_lt c.card_boundaries_pos)).mp rfl

lemma length_lt_card_boundaries : c.length < c.boundaries.card :=
by { rw c.card_boundaries_eq_succ_length, exact lt_add_one _ }

lemma lt_length (i : fin c.length) : (i : ℕ) + 1 < c.boundaries.card :=
lt_tsub_iff_right.mp i.2

lemma lt_length' (i : fin c.length) : (i : ℕ) < c.boundaries.card :=
lt_of_le_of_lt (nat.le_succ i) (c.lt_length i)

/-- Canonical increasing bijection from `fin c.boundaries.card` to `c.boundaries`. -/
def boundary : fin c.boundaries.card ↪o fin (n + 1) := c.boundaries.order_emb_of_fin rfl

@[simp] lemma boundary_zero : (c.boundary ⟨0, c.card_boundaries_pos⟩ : fin (n + 1)) = 0 :=
begin
  rw [boundary, finset.order_emb_of_fin_zero rfl c.card_boundaries_pos],
  exact le_antisymm (finset.min'_le _ _ c.zero_mem) (fin.zero_le _),
end

@[simp] lemma boundary_length : c.boundary ⟨c.length, c.length_lt_card_boundaries⟩ = fin.last n :=
begin
  convert finset.order_emb_of_fin_last rfl c.card_boundaries_pos,
  exact le_antisymm (finset.le_max' _ _ c.last_mem) (fin.le_last _)
end

/-- Size of the `i`-th block in a `composition_as_set`, seen as a function on `fin c.length`. -/
def blocks_fun (i : fin c.length) : ℕ :=
(c.boundary ⟨(i : ℕ) + 1, c.lt_length i⟩) - (c.boundary ⟨i, c.lt_length' i⟩)

lemma blocks_fun_pos (i : fin c.length) : 0 < c.blocks_fun i :=
begin
  have : (⟨i, c.lt_length' i⟩ : fin c.boundaries.card) < ⟨i + 1, c.lt_length i⟩ :=
    nat.lt_succ_self _,
  exact lt_tsub_iff_left.mpr ((c.boundaries.order_emb_of_fin rfl).strict_mono this)
end

/-- List of the sizes of the blocks in a `composition_as_set`. -/
def blocks (c : composition_as_set n) : list ℕ :=
of_fn c.blocks_fun

@[simp] lemma blocks_length : c.blocks.length = c.length :=
length_of_fn _

lemma blocks_partial_sum {i : ℕ} (h : i < c.boundaries.card) :
  (c.blocks.take i).sum = c.boundary ⟨i, h⟩ :=
begin
  induction i with i IH, { simp },
  have A : i < c.blocks.length,
  { rw c.card_boundaries_eq_succ_length at h,
    simp [blocks, nat.lt_of_succ_lt_succ h] },
  have B : i < c.boundaries.card := lt_of_lt_of_le A (by simp [blocks, length, nat.sub_le]),
  rw [sum_take_succ _ _ A, IH B],
  simp only [blocks, blocks_fun, nth_le_of_fn'],
  apply add_tsub_cancel_of_le,
  simp
end

lemma mem_boundaries_iff_exists_blocks_sum_take_eq {j : fin (n+1)} :
  j ∈ c.boundaries ↔ ∃ i < c.boundaries.card, (c.blocks.take i).sum = j :=
begin
  split,
  { assume hj,
    rcases (c.boundaries.order_iso_of_fin rfl).surjective ⟨j, hj⟩ with ⟨i, hi⟩,
    rw [subtype.ext_iff, subtype.coe_mk] at hi,
    refine ⟨i.1, i.2, _⟩,
    rw [← hi, c.blocks_partial_sum i.2],
    refl },
  { rintros ⟨i, hi, H⟩,
    convert (c.boundaries.order_iso_of_fin rfl ⟨i, hi⟩).2,
    have : c.boundary ⟨i, hi⟩ = j, by rwa [fin.ext_iff, ← c.blocks_partial_sum hi],
    exact this.symm }
end

/-- Associating a `composition n` to a `composition_as_set n`, by registering the sizes of the
blocks as a list of positive integers. -/
def to_composition : composition n :=
{ blocks     := c.blocks,
  blocks_pos := by simp only [blocks, forall_mem_of_fn_iff, blocks_fun_pos c, forall_true_iff],
  blocks_sum := c.blocks_sum }

end composition_as_set

/-!
### Equivalence between compositions and compositions as sets

In this section, we explain how to go back and forth between a `composition` and a
`composition_as_set`, by showing that their `blocks` and `length` and `boundaries` correspond to
each other, and construct an equivalence between them called `composition_equiv`.
-/

@[simp] lemma composition.to_composition_as_set_length (c : composition n) :
  c.to_composition_as_set.length = c.length :=
by simp [composition.to_composition_as_set, composition_as_set.length,
         c.card_boundaries_eq_succ_length]

@[simp] lemma composition_as_set.to_composition_length (c : composition_as_set n) :
  c.to_composition.length = c.length :=
by simp [composition_as_set.to_composition, composition.length, composition.blocks]

@[simp] lemma composition.to_composition_as_set_blocks (c : composition n) :
  c.to_composition_as_set.blocks = c.blocks :=
begin
  let d := c.to_composition_as_set,
  change d.blocks = c.blocks,
  have length_eq : d.blocks.length = c.blocks.length,
  { convert c.to_composition_as_set_length,
    simp [composition_as_set.blocks] },
  suffices H : ∀ (i ≤ d.blocks.length), (d.blocks.take i).sum = (c.blocks.take i).sum,
    from eq_of_sum_take_eq length_eq H,
  assume i hi,
  have i_lt : i < d.boundaries.card,
  { convert nat.lt_succ_iff.2 hi,
    convert d.card_boundaries_eq_succ_length,
    exact length_of_fn _ },
  have i_lt' : i < c.boundaries.card := i_lt,
  have i_lt'' : i < c.length + 1, by rwa c.card_boundaries_eq_succ_length at i_lt',
  have A : d.boundaries.order_emb_of_fin rfl ⟨i, i_lt⟩
    = c.boundaries.order_emb_of_fin c.card_boundaries_eq_succ_length ⟨i, i_lt''⟩ := rfl,
  have B : c.size_up_to i = c.boundary ⟨i, i_lt''⟩ := rfl,
  rw [d.blocks_partial_sum i_lt, composition_as_set.boundary, ← composition.size_up_to, B,
    A, c.order_emb_of_fin_boundaries]
end

@[simp] lemma composition_as_set.to_composition_blocks (c : composition_as_set n) :
  c.to_composition.blocks = c.blocks := rfl

@[simp] lemma composition_as_set.to_composition_boundaries (c : composition_as_set n) :
  c.to_composition.boundaries = c.boundaries :=
begin
  ext j,
  simp only [c.mem_boundaries_iff_exists_blocks_sum_take_eq, composition.boundaries,
    finset.mem_map],
  split,
  { rintros ⟨i, _, hi⟩,
    refine ⟨i.1, _, _⟩,
    simpa [c.card_boundaries_eq_succ_length] using i.2,
    simp [composition.boundary, composition.size_up_to, ← hi] },
  { rintros ⟨i, i_lt, hi⟩,
    refine ⟨i, by simp, _⟩,
    rw [c.card_boundaries_eq_succ_length] at i_lt,
    simp [composition.boundary, nat.mod_eq_of_lt i_lt, composition.size_up_to, hi] }
end

@[simp] lemma composition.to_composition_as_set_boundaries (c : composition n) :
  c.to_composition_as_set.boundaries = c.boundaries := rfl

/-- Equivalence between `composition n` and `composition_as_set n`. -/
def composition_equiv (n : ℕ) : composition n ≃ composition_as_set n :=
{ to_fun    := λ c, c.to_composition_as_set,
  inv_fun   := λ c, c.to_composition,
  left_inv  := λ c, by { ext1, exact c.to_composition_as_set_blocks },
  right_inv := λ c, by { ext1, exact c.to_composition_boundaries } }

instance composition_fintype (n : ℕ) : fintype (composition n) :=
fintype.of_equiv _ (composition_equiv n).symm

lemma composition_card (n : ℕ) : fintype.card (composition n) = 2 ^ (n - 1) :=
begin
  rw ← composition_as_set_card n,
  exact fintype.card_congr (composition_equiv n)
end


open classical

variables (α : Type) (p q : α → Prop)
variable a : α
variable r : Prop

example : (∃ x : α, r) → r := λ ⟨w, hr⟩, hr
example : r → (∃ x : α, r) := λ hr, ⟨a, hr⟩
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  ⟨λ ⟨w, hpw, hr⟩, ⟨⟨w, hpw⟩, hr⟩, λ ⟨⟨w, hpw⟩, hr⟩, ⟨w, hpw, hr⟩⟩
example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  ⟨λ ⟨w, hpqw⟩,
     hpqw.elim
       (λ hpw, or.inl ⟨w, hpw⟩)
       (λ hqw, or.inr ⟨w, hqw⟩),
   λ h,
     h.elim
       (λ ⟨w, hpw⟩, ⟨w, or.inl hpw⟩)
       (λ ⟨w, hqw⟩, ⟨w, or.inr hqw⟩)⟩

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  ⟨λ h ⟨w, hnpw⟩, hnpw (h w),
   λ hnen x, by_contradiction (λ hnpx, hnen ⟨x, hnpx⟩)⟩
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  ⟨λ ⟨w, hpw⟩ h, absurd hpw (h w),
   λ hnun, by_contradiction (λ hne, hnun (λ x hpx, hne ⟨x, hpx⟩))⟩
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  ⟨λ h x hpx, h ⟨x, hpx⟩, λ h ⟨w, hpw⟩, h w hpw⟩
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  ⟨λ hnu,
     by_contradiction
       (assume hnen : ¬ (∃ x, ¬ p x),
         suffices hu : ∀ x, p x, from hnu hu,
         assume x,
         by_contradiction
           (λ hnpx, hnen ⟨x, hnpx⟩)),
   λ ⟨w, hnpw⟩ hu, hnpw (hu w)⟩

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  ⟨λ h ⟨w, hpw⟩, h w hpw, λ h x hpx, h ⟨x, hpx⟩⟩
example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  ⟨λ ⟨w, hpw2r⟩ h, hpw2r (h w),
   λ h,
     by_cases
       (assume hu : ∀ x, p x,
         ⟨a, λ hpa, h hu⟩)
       (assume hnu : ¬ ∀ x, p x,
         by_contradiction
           (assume hne : ¬ ∃ x, p x → r,
             have hu : ∀ x, p x, from
               assume x,
               by_contradiction
                 (assume hnpx : ¬ p x,
                   hne ⟨x, λ hpx, (hnpx hpx).elim⟩),
             hnu hu))⟩
example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  ⟨λ ⟨w, hr2pw⟩ r, ⟨w, hr2pw r⟩,
   λ h,
     by_cases
       (assume hr : r,
         match h hr with
           ⟨w, hpw⟩ := ⟨w, λ hr, hpw⟩
         end)
       (assume hnr : ¬r,
         ⟨a, λ hr, absurd hr hnr⟩)⟩


import Math.CategoryTheory.Basic
import Math.SetTheory.Basic

open SetTheory

namespace CategoryTheory

open Category

variable [Category α]

structure Sieve (X : α) where
  maps : ∀ {Y : α}, Set (hom Y X)
  comp : ∀ {Y Z : α} {f : hom Y X} (_ : f ∈ maps) (g : hom Z Y), f ∘ g ∈ maps

namespace Sieve

def max (X : α) : Sieve X where
  maps := Set.univ _
  comp _ _ := by trivial

def pullback {X : α} (S : Sieve X) (f : hom Y X) : Sieve Y where
  maps g := f ∘ g ∈ S.maps
  comp {Y Z j} hj g := by {
    show f ∘ (j ∘ g) ∈ S.maps;
    rw [← comp_assoc];
    exact S.comp hj _;
  }

def subsieve {X : α} (R S : Sieve X) := ∀ {Y : α} {g : hom Y X}, g ∈ R.maps → g ∈ S.maps

def inter {X : α} (R S : Sieve X) : Sieve X where
  maps := R.maps ∩ S.maps
  comp := λ hf _ => ⟨R.comp (hf.1) _, S.comp (hf.2) _⟩

instance (α : Type u) [Category α] {X : α} : SetTheory.Inter (Sieve X) where
  inter := inter

--

@[simp]
theorem pullback_id {X : α} (S : Sieve X) : S.pullback (𝟙 X) = S := by {
  unfold pullback;
  congr;
  funext _ _;
  rw [id_comp]; rfl;
}

end Sieve

end CategoryTheory