/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Violeta Hernández Palacios
-/
import measure_theory.measurable_space_def
import set_theory.cardinal.cofinality
import set_theory.cardinal.continuum

/-!
# Cardinal of sigma-algebras

If a sigma-algebra is generated by a set of sets `s`, then the cardinality of the sigma-algebra is
bounded by `(max (#s) 2) ^ ℵ₀`. This is stated in `measurable_space.cardinal_generate_measurable_le`
and `measurable_space.cardinal_measurable_set_le`.

In particular, if `#s ≤ 𝔠`, then the generated sigma-algebra has cardinality at most `𝔠`, see
`measurable_space.cardinal_measurable_set_le_continuum`.

For the proof, we rely on an explicit inductive construction of the sigma-algebra generated by
`s` (instead of the inductive predicate `generate_measurable`). This transfinite inductive
construction is parameterized by an ordinal `< ω₁`, and the cardinality bound is preserved along
each step of the construction. We show in `measurable_space.generate_measurable_eq_rec` that this
indeed generates this sigma-algebra.
-/

universe u
variables {α : Type u}

open_locale cardinal
open cardinal set

local notation `ω₁` := (aleph 1 : cardinal.{u}).ord.out.α

namespace measurable_space

/-- Transfinite induction construction of the sigma-algebra generated by a set of sets `s`. At each
step, we add all elements of `s`, the empty set, the complements of already constructed sets, and
countable unions of already constructed sets. We index this construction by an ordinal `< ω₁`, as
this will be enough to generate all sets in the sigma-algebra.

This construction is very similar to that of the Borel hierarchy. -/
def generate_measurable_rec (s : set (set α)) : ω₁ → set (set α)
| i := let S := ⋃ j : Iio i, generate_measurable_rec j.1 in
    s ∪ {∅} ∪ compl '' S ∪ set.range (λ (f : ℕ → S), ⋃ n, (f n).1)
using_well_founded {dec_tac := `[exact j.2]}

theorem self_subset_generate_measurable_rec (s : set (set α)) (i : ω₁) :
  s ⊆ generate_measurable_rec s i :=
begin
  unfold generate_measurable_rec,
  apply_rules [subset_union_of_subset_left],
  exact subset_rfl
end

theorem empty_mem_generate_measurable_rec (s : set (set α)) (i : ω₁) :
  ∅ ∈ generate_measurable_rec s i :=
begin
  unfold generate_measurable_rec,
  exact mem_union_left _ (mem_union_left _ (mem_union_right _ (mem_singleton ∅)))
end

theorem compl_mem_generate_measurable_rec {s : set (set α)} {i j : ω₁} (h : j < i) {t : set α}
  (ht : t ∈ generate_measurable_rec s j) : tᶜ ∈ generate_measurable_rec s i :=
begin
  unfold generate_measurable_rec,
  exact mem_union_left _ (mem_union_right _ ⟨t, mem_Union.2 ⟨⟨j, h⟩, ht⟩, rfl⟩)
end

theorem Union_mem_generate_measurable_rec {s : set (set α)} {i : ω₁}
  {f : ℕ → set α} (hf : ∀ n, ∃ j < i, f n ∈ generate_measurable_rec s j) :
  (⋃ n, f n) ∈ generate_measurable_rec s i :=
begin
  unfold generate_measurable_rec,
  exact mem_union_right _ ⟨λ n, ⟨f n, let ⟨j, hj, hf⟩ := hf n in mem_Union.2 ⟨⟨j, hj⟩, hf⟩⟩, rfl⟩
end

theorem generate_measurable_rec_subset (s : set (set α)) {i j : ω₁} (h : i ≤ j) :
  generate_measurable_rec s i ⊆ generate_measurable_rec s j :=
λ x hx, begin
  rcases eq_or_lt_of_le h with rfl | h,
  { exact hx },
  { convert Union_mem_generate_measurable_rec (λ n, ⟨i, h, hx⟩),
    exact (Union_const x).symm }
end

/-- At each step of the inductive construction, the cardinality bound `≤ (max (#s) 2) ^ ℵ₀` holds.
-/
lemma cardinal_generate_measurable_rec_le (s : set (set α)) (i : ω₁) :
  #(generate_measurable_rec s i) ≤ (max (#s) 2) ^ aleph_0.{u} :=
begin
  apply (aleph 1).ord.out.wo.wf.induction i,
  assume i IH,
  have A := aleph_0_le_aleph 1,
  have B : aleph 1 ≤ (max (#s) 2) ^ aleph_0.{u} :=
    aleph_one_le_continuum.trans (power_le_power_right (le_max_right _ _)),
  have C : ℵ₀ ≤ (max (#s) 2) ^ aleph_0.{u} := A.trans B,
  have J : #(⋃ j : Iio i, generate_measurable_rec s j.1) ≤ (max (#s) 2) ^ aleph_0.{u},
  { apply (mk_Union_le _).trans,
    have D : (⨆ j : Iio i, #(generate_measurable_rec s j)) ≤ _ := csupr_le' (λ ⟨j, hj⟩, IH j hj),
    apply (mul_le_mul' ((mk_subtype_le _).trans (aleph 1).mk_ord_out.le) D).trans,
    rw mul_eq_max A C,
    exact max_le B le_rfl },
  rw [generate_measurable_rec],
  apply_rules [(mk_union_le _ _).trans, add_le_of_le C, mk_image_le.trans],
  { exact (le_max_left _ _).trans (self_le_power _ one_lt_aleph_0.le) },
  { rw [mk_singleton],
    exact one_lt_aleph_0.le.trans C },
  { apply mk_range_le.trans,
    simp only [mk_pi, subtype.val_eq_coe, prod_const, lift_uzero, mk_denumerable, lift_aleph_0],
    have := @power_le_power_right _ _ ℵ₀ J,
    rwa [← power_mul, aleph_0_mul_aleph_0] at this }
end

/-- `generate_measurable_rec s` generates precisely the smallest sigma-algebra containing `s`. -/
theorem generate_measurable_eq_rec (s : set (set α)) :
  {t | generate_measurable s t} = ⋃ i, generate_measurable_rec s i :=
begin
  ext t, refine ⟨λ ht, _, λ ht, _⟩,
  { inhabit ω₁,
    induction ht with u hu u hu IH f hf IH,
    { exact mem_Union.2 ⟨default, self_subset_generate_measurable_rec s _ hu⟩ },
    { exact mem_Union.2 ⟨default, empty_mem_generate_measurable_rec s _⟩ },
    { rcases mem_Union.1 IH with ⟨i, hi⟩,
      obtain ⟨j, hj⟩ := exists_gt i,
      exact mem_Union.2 ⟨j, compl_mem_generate_measurable_rec hj hi⟩ },
    { have : ∀ n, ∃ i, f n ∈ generate_measurable_rec s i := λ n, by simpa using IH n,
      choose I hI using this,
      refine mem_Union.2 ⟨ordinal.enum (<) (ordinal.lsub (λ n, ordinal.typein.{u} (<) (I n))) _,
        Union_mem_generate_measurable_rec (λ n, ⟨I n, _, hI n⟩)⟩,
      { rw ordinal.type_lt,
        refine ordinal.lsub_lt_ord_lift _ (λ i, ordinal.typein_lt_self _),
        rw [mk_denumerable, lift_aleph_0, is_regular_aleph_one.cof_eq],
        exact aleph_0_lt_aleph_one },
      { rw [←ordinal.typein_lt_typein (<), ordinal.typein_enum],
        apply ordinal.lt_lsub (λ n : ℕ, _) } } },
  { rcases ht with ⟨t, ⟨i, rfl⟩, hx⟩,
    revert t,
    apply (aleph 1).ord.out.wo.wf.induction i,
    intros j H t ht,
    unfold generate_measurable_rec at ht,
    rcases ht with (((h | h) | ⟨u, ⟨-, ⟨⟨k, hk⟩, rfl⟩, hu⟩, rfl⟩) | ⟨f, rfl⟩),
    { exact generate_measurable.basic t h },
    { convert generate_measurable.empty },
    { exact generate_measurable.compl u (H k hk u hu) },
    { apply generate_measurable.union _ (λ n, _),
      obtain ⟨-, ⟨⟨k, hk⟩, rfl⟩, hf⟩ := (f n).prop,
      exact H k hk _ hf } }
end

/-- If a sigma-algebra is generated by a set of sets `s`, then the sigma-algebra has cardinality at
most `(max (#s) 2) ^ ℵ₀`. -/
theorem cardinal_generate_measurable_le (s : set (set α)) :
  #{t | generate_measurable s t} ≤ (max (#s) 2) ^ aleph_0.{u} :=
begin
  rw generate_measurable_eq_rec,
  apply (mk_Union_le _).trans,
  rw (aleph 1).mk_ord_out,
  refine le_trans (mul_le_mul' aleph_one_le_continuum
    (csupr_le' (λ i, cardinal_generate_measurable_rec_le s i))) _,
  have := power_le_power_right (le_max_right (#s) 2),
  rw mul_eq_max aleph_0_le_continuum (aleph_0_le_continuum.trans this),
  exact max_le this le_rfl
end

/-- If a sigma-algebra is generated by a set of sets `s`, then the sigma
algebra has cardinality at most `(max (#s) 2) ^ ℵ₀`. -/
theorem cardinal_measurable_set_le (s : set (set α)) :
  #{t | @measurable_set α (generate_from s) t} ≤ (max (#s) 2) ^ aleph_0.{u} :=
cardinal_generate_measurable_le s

/-- If a sigma-algebra is generated by a set of sets `s` with cardinality at most the continuum,
then the sigma algebra has the same cardinality bound. -/
theorem cardinal_generate_measurable_le_continuum {s : set (set α)} (hs : #s ≤ 𝔠) :
  #{t | generate_measurable s t} ≤ 𝔠 :=
(cardinal_generate_measurable_le s).trans begin
  rw ←continuum_power_aleph_0,
  exact_mod_cast power_le_power_right (max_le hs (nat_lt_continuum 2).le)
end

/-- If a sigma-algebra is generated by a set of sets `s` with cardinality at most the continuum,
then the sigma algebra has the same cardinality bound. -/
theorem cardinal_measurable_set_le_continuum {s : set (set α)} :
  #s ≤ 𝔠 → #{t | @measurable_set α (generate_from s) t} ≤ 𝔠 :=
cardinal_generate_measurable_le_continuum

end measurable_space


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Sébastien Gouëzel
-/
import analysis.normed_space.basic

/-!
# Completeness in terms of `cauchy` filters vs `is_cau_seq` sequences

In this file we apply `metric.complete_of_cauchy_seq_tendsto` to prove that a `normed_ring`
is complete in terms of `cauchy` filter if and only if it is complete in terms
of `cau_seq` Cauchy sequences.
-/

universes u v
open set filter
open_locale topological_space classical

variable {β : Type v}

lemma cau_seq.tendsto_limit [normed_ring β] [hn : is_absolute_value (norm : β → ℝ)]
  (f : cau_seq β norm) [cau_seq.is_complete β norm] :
  tendsto f at_top (𝓝 f.lim) :=
_root_.tendsto_nhds.mpr
begin
  intros s os lfs,
  suffices : ∃ (a : ℕ), ∀ (b : ℕ), b ≥ a → f b ∈ s, by simpa using this,
  rcases metric.is_open_iff.1 os _ lfs with ⟨ε, ⟨hε, hεs⟩⟩,
  cases setoid.symm (cau_seq.equiv_lim f) _ hε with N hN,
  existsi N,
  intros b hb,
  apply hεs,
  dsimp [metric.ball], rw [dist_comm, dist_eq_norm],
  solve_by_elim
end

variables [normed_field β]

/-
 This section shows that if we have a uniform space generated by an absolute value, topological
 completeness and Cauchy sequence completeness coincide. The problem is that there isn't
 a good notion of "uniform space generated by an absolute value", so right now this is
 specific to norm. Furthermore, norm only instantiates is_absolute_value on normed_field.
 This needs to be fixed, since it prevents showing that ℤ_[hp] is complete
-/

instance normed_field.is_absolute_value : is_absolute_value (norm : β → ℝ) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := λ _, norm_eq_zero,
  abv_add := norm_add_le,
  abv_mul := norm_mul }

open metric

lemma cauchy_seq.is_cau_seq {f : ℕ → β} (hf : cauchy_seq f) :
  is_cau_seq norm f :=
begin
  cases cauchy_iff.1 hf with hf1 hf2,
  intros ε hε,
  rcases hf2 {x | dist x.1 x.2 < ε} (dist_mem_uniformity hε) with ⟨t, ⟨ht, htsub⟩⟩,
  simp at ht, cases ht with N hN,
  existsi N,
  intros j hj,
  rw ←dist_eq_norm,
  apply @htsub (f j, f N),
  apply set.mk_mem_prod; solve_by_elim [le_refl]
end

lemma cau_seq.cauchy_seq (f : cau_seq β norm) : cauchy_seq f :=
begin
  refine cauchy_iff.2 ⟨by apply_instance, λ s hs, _⟩,
  rcases mem_uniformity_dist.1 hs with ⟨ε, ⟨hε, hεs⟩⟩,
  cases cau_seq.cauchy₂ f hε with N hN,
  existsi {n | n ≥ N}.image f,
  simp only [exists_prop, mem_at_top_sets, mem_map, mem_image, ge_iff_le, mem_set_of_eq],
  split,
  { existsi N, intros b hb, existsi b, simp [hb] },
  { rintros ⟨a, b⟩ ⟨⟨a', ⟨ha'1, ha'2⟩⟩, ⟨b', ⟨hb'1, hb'2⟩⟩⟩,
    dsimp at ha'1 ha'2 hb'1 hb'2,
    rw [←ha'2, ←hb'2],
    apply hεs,
    rw dist_eq_norm,
    apply hN; assumption }
end

/-- In a normed field, `cau_seq` coincides with the usual notion of Cauchy sequences. -/
lemma cau_seq_iff_cauchy_seq {α : Type u} [normed_field α] {u : ℕ → α} :
  is_cau_seq norm u ↔ cauchy_seq u :=
⟨λh, cau_seq.cauchy_seq ⟨u, h⟩,
 λh, h.is_cau_seq⟩

/-- A complete normed field is complete as a metric space, as Cauchy sequences converge by
assumption and this suffices to characterize completeness. -/
@[priority 100] -- see Note [lower instance priority]
instance complete_space_of_cau_seq_complete [cau_seq.is_complete β norm] : complete_space β :=
begin
  apply complete_of_cauchy_seq_tendsto,
  assume u hu,
  have C : is_cau_seq norm u := cau_seq_iff_cauchy_seq.2 hu,
  existsi cau_seq.lim ⟨u, C⟩,
  rw metric.tendsto_at_top,
  assume ε εpos,
  cases (cau_seq.equiv_lim ⟨u, C⟩) _ εpos with N hN,
  existsi N,
  simpa [dist_eq_norm] using hN
end


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

! This file was ported from Lean 3 source module ring_theory.etale
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.QuotientNilpotent
import Mathbin.RingTheory.Derivation

/-!

# Formally étale morphisms

An `R`-algebra `A` is formally étale (resp. unramified, smooth) if for every `R`-algebra,
every square-zero ideal `I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists
exactly (resp. at most, at least) one lift `A →ₐ[R] B`.

We show that the property extends onto nilpotent ideals, and that these properties are stable
under `R`-algebra homomorphisms and compositions.

-/

universe u

namespace Algebra

section

variable (R : Type u) [CommSemiring R]

variable (A : Type u) [Semiring A] [Algebra R A]

variable {B : Type u} [CommRing B] [Algebra R B] (I : Ideal B)

include R A

/-- An `R`-algebra `A` is formally unramified if for every `R`-algebra, every square-zero ideal
`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists at most one lift `A →ₐ[R] B`. -/
@[mk_iff]
class FormallyUnramified : Prop where
  comp_injective :
    ∀ ⦃B : Type u⦄ [CommRing B],
      ∀ [Algebra R B] (I : Ideal B) (hI : I ^ 2 = ⊥),
        Function.Injective ((Ideal.Quotient.mkₐ R I).comp : (A →ₐ[R] B) → A →ₐ[R] B ⧸ I)
#align algebra.formally_unramified Algebra.FormallyUnramified

/-- An `R` algebra `A` is formally smooth if for every `R`-algebra, every square-zero ideal
`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists at least one lift `A →ₐ[R] B`. -/
@[mk_iff]
class FormallySmooth : Prop where
  comp_surjective :
    ∀ ⦃B : Type u⦄ [CommRing B],
      ∀ [Algebra R B] (I : Ideal B) (hI : I ^ 2 = ⊥),
        Function.Surjective ((Ideal.Quotient.mkₐ R I).comp : (A →ₐ[R] B) → A →ₐ[R] B ⧸ I)
#align algebra.formally_smooth Algebra.FormallySmooth

/-- An `R` algebra `A` is formally étale if for every `R`-algebra, every square-zero ideal
`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists exactly one lift `A →ₐ[R] B`. -/
@[mk_iff]
class FormallyEtale : Prop where
  comp_bijective :
    ∀ ⦃B : Type u⦄ [CommRing B],
      ∀ [Algebra R B] (I : Ideal B) (hI : I ^ 2 = ⊥),
        Function.Bijective ((Ideal.Quotient.mkₐ R I).comp : (A →ₐ[R] B) → A →ₐ[R] B ⧸ I)
#align algebra.formally_etale Algebra.FormallyEtale

variable {R A}

theorem FormallyEtale.iff_unramified_and_smooth :
    FormallyEtale R A ↔ FormallyUnramified R A ∧ FormallySmooth R A :=
  by
  rw [formally_unramified_iff, formally_smooth_iff, formally_etale_iff]
  simp_rw [← forall_and]
  rfl
#align algebra.formally_etale.iff_unramified_and_smooth Algebra.FormallyEtale.iff_unramified_and_smooth

instance (priority := 100) FormallyEtale.to_unramified [h : FormallyEtale R A] :
    FormallyUnramified R A :=
  (FormallyEtale.iff_unramified_and_smooth.mp h).1
#align algebra.formally_etale.to_unramified Algebra.FormallyEtale.to_unramified

instance (priority := 100) FormallyEtale.to_smooth [h : FormallyEtale R A] : FormallySmooth R A :=
  (FormallyEtale.iff_unramified_and_smooth.mp h).2
#align algebra.formally_etale.to_smooth Algebra.FormallyEtale.to_smooth

theorem FormallyEtale.of_unramified_and_smooth [h₁ : FormallyUnramified R A]
    [h₂ : FormallySmooth R A] : FormallyEtale R A :=
  FormallyEtale.iff_unramified_and_smooth.mpr ⟨h₁, h₂⟩
#align algebra.formally_etale.of_unramified_and_smooth Algebra.FormallyEtale.of_unramified_and_smooth

omit R A

theorem FormallyUnramified.lift_unique {B : Type u} [CommRing B] [_RB : Algebra R B]
    [FormallyUnramified R A] (I : Ideal B) (hI : IsNilpotent I) (g₁ g₂ : A →ₐ[R] B)
    (h : (Ideal.Quotient.mkₐ R I).comp g₁ = (Ideal.Quotient.mkₐ R I).comp g₂) : g₁ = g₂ :=
  by
  revert g₁ g₂
  change Function.Injective (Ideal.Quotient.mkₐ R I).comp
  revert _RB
  apply Ideal.IsNilpotent.induction_on I hI
  · intro B _ I hI _
    exact formally_unramified.comp_injective I hI
  · intro B _ I J hIJ h₁ h₂ _ g₁ g₂ e
    apply h₁
    apply h₂
    ext x
    replace e := AlgHom.congr_fun e x
    dsimp only [AlgHom.comp_apply, Ideal.Quotient.mkₐ_eq_mk] at e⊢
    rwa [Ideal.Quotient.eq, ← map_sub, Ideal.mem_quotient_iff_mem hIJ, ← Ideal.Quotient.eq]
#align algebra.formally_unramified.lift_unique Algebra.FormallyUnramified.lift_unique

theorem FormallyUnramified.ext [FormallyUnramified R A] (hI : IsNilpotent I) {g₁ g₂ : A →ₐ[R] B}
    (H : ∀ x, Ideal.Quotient.mk I (g₁ x) = Ideal.Quotient.mk I (g₂ x)) : g₁ = g₂ :=
  FormallyUnramified.lift_unique I hI g₁ g₂ (AlgHom.ext H)
#align algebra.formally_unramified.ext Algebra.FormallyUnramified.ext

theorem FormallyUnramified.lift_unique_of_ringHom [FormallyUnramified R A] {C : Type u} [CommRing C]
    (f : B →+* C) (hf : IsNilpotent f.ker) (g₁ g₂ : A →ₐ[R] B)
    (h : f.comp ↑g₁ = f.comp (g₂ : A →+* B)) : g₁ = g₂ :=
  FormallyUnramified.lift_unique _ hf _ _
    (by
      ext x
      have := RingHom.congr_fun h x
      simpa only [Ideal.Quotient.eq, Function.comp_apply, AlgHom.coe_comp, Ideal.Quotient.mkₐ_eq_mk,
        RingHom.mem_ker, map_sub, sub_eq_zero] )
#align algebra.formally_unramified.lift_unique_of_ring_hom Algebra.FormallyUnramified.lift_unique_of_ringHom

theorem FormallyUnramified.ext' [FormallyUnramified R A] {C : Type u} [CommRing C] (f : B →+* C)
    (hf : IsNilpotent f.ker) (g₁ g₂ : A →ₐ[R] B) (h : ∀ x, f (g₁ x) = f (g₂ x)) : g₁ = g₂ :=
  FormallyUnramified.lift_unique_of_ringHom f hf g₁ g₂ (RingHom.ext h)
#align algebra.formally_unramified.ext' Algebra.FormallyUnramified.ext'

theorem FormallyUnramified.lift_unique' [FormallyUnramified R A] {C : Type u} [CommRing C]
    [Algebra R C] (f : B →ₐ[R] C) (hf : IsNilpotent (f : B →+* C).ker) (g₁ g₂ : A →ₐ[R] B)
    (h : f.comp g₁ = f.comp g₂) : g₁ = g₂ :=
  FormallyUnramified.ext' _ hf g₁ g₂ (AlgHom.congr_fun h)
#align algebra.formally_unramified.lift_unique' Algebra.FormallyUnramified.lift_unique'

theorem FormallySmooth.exists_lift {B : Type u} [CommRing B] [_RB : Algebra R B]
    [FormallySmooth R A] (I : Ideal B) (hI : IsNilpotent I) (g : A →ₐ[R] B ⧸ I) :
    ∃ f : A →ₐ[R] B, (Ideal.Quotient.mkₐ R I).comp f = g :=
  by
  revert g
  change Function.Surjective (Ideal.Quotient.mkₐ R I).comp
  revert _RB
  apply Ideal.IsNilpotent.induction_on I hI
  · intro B _ I hI _
    exact formally_smooth.comp_surjective I hI
  · intro B _ I J hIJ h₁ h₂ _ g
    let this : ((B ⧸ I) ⧸ J.map (Ideal.Quotient.mk I)) ≃ₐ[R] B ⧸ J :=
      {
        (DoubleQuot.quotQuotEquivQuotSup I J).trans
          (Ideal.quotEquivOfEq (sup_eq_right.mpr hIJ)) with
        commutes' := fun x => rfl }
    obtain ⟨g', e⟩ := h₂ (this.symm.to_alg_hom.comp g)
    obtain ⟨g', rfl⟩ := h₁ g'
    replace e := congr_arg this.to_alg_hom.comp e
    conv_rhs at e =>
      rw [← AlgHom.comp_assoc, AlgEquiv.toAlgHom_eq_coe, AlgEquiv.toAlgHom_eq_coe,
        AlgEquiv.comp_symm, AlgHom.id_comp]
    exact ⟨g', e⟩
#align algebra.formally_smooth.exists_lift Algebra.FormallySmooth.exists_lift

/-- For a formally smooth `R`-algebra `A` and a map `f : A →ₐ[R] B ⧸ I` with `I` square-zero,
this is an arbitrary lift `A →ₐ[R] B`. -/
noncomputable def FormallySmooth.lift [FormallySmooth R A] (I : Ideal B) (hI : IsNilpotent I)
    (g : A →ₐ[R] B ⧸ I) : A →ₐ[R] B :=
  (FormallySmooth.exists_lift I hI g).some
#align algebra.formally_smooth.lift Algebra.FormallySmooth.lift

@[simp]
theorem FormallySmooth.comp_lift [FormallySmooth R A] (I : Ideal B) (hI : IsNilpotent I)
    (g : A →ₐ[R] B ⧸ I) : (Ideal.Quotient.mkₐ R I).comp (FormallySmooth.lift I hI g) = g :=
  (FormallySmooth.exists_lift I hI g).choose_spec
#align algebra.formally_smooth.comp_lift Algebra.FormallySmooth.comp_lift

@[simp]
theorem FormallySmooth.mk_lift [FormallySmooth R A] (I : Ideal B) (hI : IsNilpotent I)
    (g : A →ₐ[R] B ⧸ I) (x : A) : Ideal.Quotient.mk I (FormallySmooth.lift I hI g x) = g x :=
  AlgHom.congr_fun (FormallySmooth.comp_lift I hI g : _) x
#align algebra.formally_smooth.mk_lift Algebra.FormallySmooth.mk_lift

variable {C : Type u} [CommRing C] [Algebra R C]

/-- For a formally smooth `R`-algebra `A` and a map `f : A →ₐ[R] B ⧸ I` with `I` nilpotent,
this is an arbitrary lift `A →ₐ[R] B`. -/
noncomputable def FormallySmooth.liftOfSurjective [FormallySmooth R A] (f : A →ₐ[R] C)
    (g : B →ₐ[R] C) (hg : Function.Surjective g) (hg' : IsNilpotent (g : B →+* C).ker) :
    A →ₐ[R] B :=
  FormallySmooth.lift _ hg' ((Ideal.quotientKerAlgEquivOfSurjective hg).symm.toAlgHom.comp f)
#align algebra.formally_smooth.lift_of_surjective Algebra.FormallySmooth.liftOfSurjective

@[simp]
theorem FormallySmooth.liftOfSurjective_apply [FormallySmooth R A] (f : A →ₐ[R] C) (g : B →ₐ[R] C)
    (hg : Function.Surjective g) (hg' : IsNilpotent (g : B →+* C).ker) (x : A) :
    g (FormallySmooth.liftOfSurjective f g hg hg' x) = f x :=
  by
  apply (Ideal.quotientKerAlgEquivOfSurjective hg).symm.Injective
  change _ = ((Ideal.quotientKerAlgEquivOfSurjective hg).symm.toAlgHom.comp f) x
  rw [←
    formally_smooth.mk_lift _ hg' ((Ideal.quotientKerAlgEquivOfSurjective hg).symm.toAlgHom.comp f)]
  apply (Ideal.quotientKerAlgEquivOfSurjective hg).Injective
  rw [AlgEquiv.apply_symm_apply, Ideal.quotientKerAlgEquivOfSurjective,
    Ideal.quotientKerAlgEquivOfRightInverse.apply]
  exact (Ideal.kerLiftAlg_mk _ _).symm
#align algebra.formally_smooth.lift_of_surjective_apply Algebra.FormallySmooth.liftOfSurjective_apply

@[simp]
theorem FormallySmooth.comp_liftOfSurjective [FormallySmooth R A] (f : A →ₐ[R] C) (g : B →ₐ[R] C)
    (hg : Function.Surjective g) (hg' : IsNilpotent (g : B →+* C).ker) :
    g.comp (FormallySmooth.liftOfSurjective f g hg hg') = f :=
  AlgHom.ext (FormallySmooth.liftOfSurjective_apply f g hg hg')
#align algebra.formally_smooth.comp_lift_of_surjective Algebra.FormallySmooth.comp_liftOfSurjective

end

section OfEquiv

variable {R : Type u} [CommSemiring R]

variable {A B : Type u} [Semiring A] [Algebra R A] [Semiring B] [Algebra R B]

theorem FormallySmooth.of_equiv [FormallySmooth R A] (e : A ≃ₐ[R] B) : FormallySmooth R B :=
  by
  constructor
  intro C _ _ I hI f
  use (formally_smooth.lift I ⟨2, hI⟩ (f.comp e : A →ₐ[R] C ⧸ I)).comp e.symm
  rw [← AlgHom.comp_assoc, formally_smooth.comp_lift, AlgHom.comp_assoc, AlgEquiv.comp_symm,
    AlgHom.comp_id]
#align algebra.formally_smooth.of_equiv Algebra.FormallySmooth.of_equiv

theorem FormallyUnramified.of_equiv [FormallyUnramified R A] (e : A ≃ₐ[R] B) :
    FormallyUnramified R B := by
  constructor
  intro C _ _ I hI f₁ f₂ e'
  rw [← f₁.comp_id, ← f₂.comp_id, ← e.comp_symm, ← AlgHom.comp_assoc, ← AlgHom.comp_assoc]
  congr 1
  refine' formally_unramified.comp_injective I hI _
  rw [← AlgHom.comp_assoc, e', AlgHom.comp_assoc]
#align algebra.formally_unramified.of_equiv Algebra.FormallyUnramified.of_equiv

theorem FormallyEtale.of_equiv [FormallyEtale R A] (e : A ≃ₐ[R] B) : FormallyEtale R B :=
  FormallyEtale.iff_unramified_and_smooth.mpr
    ⟨FormallyUnramified.of_equiv e, FormallySmooth.of_equiv e⟩
#align algebra.formally_etale.of_equiv Algebra.FormallyEtale.of_equiv

end OfEquiv

section Polynomial

open Polynomial

variable (R : Type u) [CommSemiring R]

instance FormallySmooth.mvPolynomial (σ : Type u) : FormallySmooth R (MvPolynomial σ R) :=
  by
  constructor
  intro C _ _ I hI f
  have : ∀ s : σ, ∃ c : C, Ideal.Quotient.mk I c = f (MvPolynomial.X s) := fun s =>
    Ideal.Quotient.mk_surjective _
  choose g hg
  refine' ⟨MvPolynomial.aeval g, _⟩
  ext s
  rw [← hg, AlgHom.comp_apply, MvPolynomial.aeval_X]
  rfl
#align algebra.formally_smooth.mv_polynomial Algebra.FormallySmooth.mvPolynomial

instance FormallySmooth.polynomial : FormallySmooth R R[X] :=
  @FormallySmooth.of_equiv _ _ _ _ _ (FormallySmooth.mvPolynomial R PUnit)
    (MvPolynomial.pUnitAlgEquiv R)
#align algebra.formally_smooth.polynomial Algebra.FormallySmooth.polynomial

end Polynomial

section Comp

variable (R : Type u) [CommSemiring R]

variable (A : Type u) [CommSemiring A] [Algebra R A]

variable (B : Type u) [Semiring B] [Algebra R B] [Algebra A B] [IsScalarTower R A B]

theorem FormallySmooth.comp [FormallySmooth R A] [FormallySmooth A B] : FormallySmooth R B :=
  by
  constructor
  intro C _ _ I hI f
  obtain ⟨f', e⟩ := formally_smooth.comp_surjective I hI (f.comp (IsScalarTower.toAlgHom R A B))
  letI := f'.to_ring_hom.to_algebra
  obtain ⟨f'', e'⟩ :=
    formally_smooth.comp_surjective I hI { f.to_ring_hom with commutes' := AlgHom.congr_fun e.symm }
  apply_fun AlgHom.restrictScalars R  at e'
  exact ⟨f''.restrict_scalars _, e'.trans (AlgHom.ext fun _ => rfl)⟩
#align algebra.formally_smooth.comp Algebra.FormallySmooth.comp

theorem FormallyUnramified.comp [FormallyUnramified R A] [FormallyUnramified A B] :
    FormallyUnramified R B := by
  constructor
  intro C _ _ I hI f₁ f₂ e
  have e' :=
    formally_unramified.lift_unique I ⟨2, hI⟩ (f₁.comp <| IsScalarTower.toAlgHom R A B)
      (f₂.comp <| IsScalarTower.toAlgHom R A B) (by rw [← AlgHom.comp_assoc, e, AlgHom.comp_assoc])
  letI := (f₁.comp (IsScalarTower.toAlgHom R A B)).toRingHom.toAlgebra
  let F₁ : B →ₐ[A] C := { f₁ with commutes' := fun r => rfl }
  let F₂ : B →ₐ[A] C := { f₂ with commutes' := AlgHom.congr_fun e'.symm }
  ext1
  change F₁ x = F₂ x
  congr
  exact formally_unramified.ext I ⟨2, hI⟩ (AlgHom.congr_fun e)
#align algebra.formally_unramified.comp Algebra.FormallyUnramified.comp

theorem FormallyUnramified.of_comp [FormallyUnramified R B] : FormallyUnramified A B :=
  by
  constructor
  intro Q _ _ I e f₁ f₂ e'
  letI := ((algebraMap A Q).comp (algebraMap R A)).toAlgebra
  letI : IsScalarTower R A Q := IsScalarTower.of_algebraMap_eq' rfl
  refine' AlgHom.restrictScalars_injective R _
  refine' formally_unramified.ext I ⟨2, e⟩ _
  intro x
  exact AlgHom.congr_fun e' x
#align algebra.formally_unramified.of_comp Algebra.FormallyUnramified.of_comp

theorem FormallyEtale.comp [FormallyEtale R A] [FormallyEtale A B] : FormallyEtale R B :=
  FormallyEtale.iff_unramified_and_smooth.mpr
    ⟨FormallyUnramified.comp R A B, FormallySmooth.comp R A B⟩
#align algebra.formally_etale.comp Algebra.FormallyEtale.comp

end Comp

section OfSurjective

variable {R S : Type u} [CommRing R] [CommSemiring S]

variable {P A : Type u} [CommRing A] [Algebra R A] [CommRing P] [Algebra R P]

variable (I : Ideal P) (f : P →ₐ[R] A) (hf : Function.Surjective f)

theorem FormallySmooth.of_split [FormallySmooth R P] (g : A →ₐ[R] P ⧸ f.toRingHom.ker ^ 2)
    (hg : f.kerSquareLift.comp g = AlgHom.id R A) : FormallySmooth R A :=
  by
  constructor
  intro C _ _ I hI i
  let l : P ⧸ f.to_ring_hom.ker ^ 2 →ₐ[R] C :=
    by
    refine' Ideal.Quotient.liftₐ _ (formally_smooth.lift I ⟨2, hI⟩ (i.comp f)) _
    have : RingHom.ker f ≤ I.comap (formally_smooth.lift I ⟨2, hI⟩ (i.comp f)) :=
      by
      rintro x (hx : f x = 0)
      have : _ = i (f x) := (formally_smooth.mk_lift I ⟨2, hI⟩ (i.comp f) x : _)
      rwa [hx, map_zero, ← Ideal.Quotient.mk_eq_mk, Submodule.Quotient.mk_eq_zero] at this
    intro x hx
    have := (Ideal.pow_mono this 2).trans (Ideal.le_comap_pow _ 2) hx
    rwa [hI] at this
  have : i.comp f.ker_square_lift = (Ideal.Quotient.mkₐ R _).comp l :=
    by
    apply AlgHom.coe_ringHom_injective
    apply Ideal.Quotient.ringHom_ext
    ext x
    exact (formally_smooth.mk_lift I ⟨2, hI⟩ (i.comp f) x).symm
  exact ⟨l.comp g, by rw [← AlgHom.comp_assoc, ← this, AlgHom.comp_assoc, hg, AlgHom.comp_id]⟩
#align algebra.formally_smooth.of_split Algebra.FormallySmooth.of_split

include hf

/-- Let `P →ₐ[R] A` be a surjection with kernel `J`, and `P` a formally smooth `R`-algebra,
then `A` is formally smooth over `R` iff the surjection `P ⧸ J ^ 2 →ₐ[R] A` has a section.

Geometric intuition: we require that a first-order thickening of `Spec A` inside `Spec P` admits
a retraction. -/
theorem FormallySmooth.iff_split_surjection [FormallySmooth R P] :
    FormallySmooth R A ↔ ∃ g, f.kerSquareLift.comp g = AlgHom.id R A :=
  by
  constructor
  · intro
    have surj : Function.Surjective f.ker_square_lift := fun x =>
      ⟨Submodule.Quotient.mk (hf x).some, (hf x).choose_spec⟩
    have sqz : RingHom.ker f.ker_square_lift.to_ring_hom ^ 2 = 0 := by
      rw [AlgHom.ker_ker_sqare_lift, Ideal.cotangentIdeal_square, Ideal.zero_eq_bot]
    refine'
      ⟨formally_smooth.lift _ ⟨2, sqz⟩ (Ideal.quotientKerAlgEquivOfSurjective surj).symm.toAlgHom,
        _⟩
    ext x
    have :=
      (Ideal.quotientKerAlgEquivOfSurjective surj).toAlgHom.congr_arg
        (formally_smooth.mk_lift _ ⟨2, sqz⟩
          (Ideal.quotientKerAlgEquivOfSurjective surj).symm.toAlgHom x)
    dsimp at this
    rw [AlgEquiv.apply_symm_apply] at this
    conv_rhs => rw [← this, AlgHom.id_apply]
    obtain ⟨y, e⟩ :=
      Ideal.Quotient.mk_surjective
        (formally_smooth.lift _ ⟨2, sqz⟩ (Ideal.quotientKerAlgEquivOfSurjective surj).symm.toAlgHom
          x)
    dsimp at e⊢
    rw [← e]
    rfl
  · rintro ⟨g, hg⟩
    exact formally_smooth.of_split f g hg
#align algebra.formally_smooth.iff_split_surjection Algebra.FormallySmooth.iff_split_surjection

end OfSurjective

section UnramifiedDerivation

open TensorProduct

variable {R S : Type u} [CommRing R] [CommRing S] [Algebra R S]

instance FormallyUnramified.subsingleton_kaehlerDifferential [FormallyUnramified R S] :
    Subsingleton (Ω[S⁄R]) := by
  rw [← not_nontrivial_iff_subsingleton]
  intro h
  obtain ⟨f₁, f₂, e⟩ := (KaehlerDifferential.endEquiv R S).Injective.Nontrivial
  apply e
  ext1
  apply formally_unramified.lift_unique' _ _ _ _ (f₁.2.trans f₂.2.symm)
  rw [← AlgHom.toRingHom_eq_coe, AlgHom.ker_ker_sqare_lift]
  exact ⟨_, Ideal.cotangentIdeal_square _⟩
#align algebra.formally_unramified.subsingleton_kaehler_differential Algebra.FormallyUnramified.subsingleton_kaehlerDifferential

theorem FormallyUnramified.iff_subsingleton_kaehlerDifferential :
    FormallyUnramified R S ↔ Subsingleton (Ω[S⁄R]) :=
  by
  constructor
  · intros
    infer_instance
  · intro H
    constructor
    intro B _ _ I hI f₁ f₂ e
    letI := f₁.to_ring_hom.to_algebra
    haveI := IsScalarTower.of_algebraMap_eq' f₁.comp_algebra_map.symm
    have :=
      ((KaehlerDifferential.linearMapEquivDerivation R S).toEquiv.trans
            (derivationToSquareZeroEquivLift I hI)).Surjective.Subsingleton
    exact subtype.ext_iff.mp (@Subsingleton.elim this ⟨f₁, rfl⟩ ⟨f₂, e.symm⟩)
#align algebra.formally_unramified.iff_subsingleton_kaehler_differential Algebra.FormallyUnramified.iff_subsingleton_kaehlerDifferential

end UnramifiedDerivation

section BaseChange

open TensorProduct

variable {R : Type u} [CommSemiring R]

variable {A : Type u} [Semiring A] [Algebra R A]

variable (B : Type u) [CommSemiring B] [Algebra R B]

instance FormallyUnramified.base_change [FormallyUnramified R A] :
    FormallyUnramified B (B ⊗[R] A) := by
  constructor
  intro C _ _ I hI f₁ f₂ e
  letI := ((algebraMap B C).comp (algebraMap R B)).toAlgebra
  haveI : IsScalarTower R B C := IsScalarTower.of_algebraMap_eq' rfl
  apply AlgHom.restrictScalars_injective R
  apply TensorProduct.ext
  any_goals infer_instance
  intro b a
  have : b ⊗ₜ[R] a = b • 1 ⊗ₜ a := by rw [TensorProduct.smul_tmul', smul_eq_mul, mul_one]
  rw [this, AlgHom.restrictScalars_apply, AlgHom.restrictScalars_apply, map_smul, map_smul]
  congr 1
  change
    ((f₁.restrict_scalars R).comp tensor_product.include_right) a =
      ((f₂.restrict_scalars R).comp tensor_product.include_right) a
  congr 1
  refine' formally_unramified.ext I ⟨2, hI⟩ _
  intro x
  exact AlgHom.congr_fun e (1 ⊗ₜ x)
#align algebra.formally_unramified.base_change Algebra.FormallyUnramified.base_change

instance FormallySmooth.base_change [FormallySmooth R A] : FormallySmooth B (B ⊗[R] A) :=
  by
  constructor
  intro C _ _ I hI f
  letI := ((algebraMap B C).comp (algebraMap R B)).toAlgebra
  haveI : IsScalarTower R B C := IsScalarTower.of_algebraMap_eq' rfl
  refine' ⟨tensor_product.product_left_alg_hom (Algebra.ofId B C) _, _⟩
  · exact formally_smooth.lift I ⟨2, hI⟩ ((f.restrict_scalars R).comp tensor_product.include_right)
  · apply AlgHom.restrictScalars_injective R
    apply TensorProduct.ext
    any_goals infer_instance
    intro b a
    suffices algebraMap B _ b * f (1 ⊗ₜ[R] a) = f (b ⊗ₜ[R] a) by simpa [Algebra.ofId_apply]
    rw [← Algebra.smul_def, ← map_smul, TensorProduct.smul_tmul', smul_eq_mul, mul_one]
#align algebra.formally_smooth.base_change Algebra.FormallySmooth.base_change

instance FormallyEtale.base_change [FormallyEtale R A] : FormallyEtale B (B ⊗[R] A) :=
  FormallyEtale.iff_unramified_and_smooth.mpr ⟨inferInstance, inferInstance⟩
#align algebra.formally_etale.base_change Algebra.FormallyEtale.base_change

end BaseChange

section Localization

variable {R S Rₘ Sₘ : Type u} [CommRing R] [CommRing S] [CommRing Rₘ] [CommRing Sₘ]

variable (M : Submonoid R)

variable [Algebra R S] [Algebra R Sₘ] [Algebra S Sₘ] [Algebra R Rₘ] [Algebra Rₘ Sₘ]

variable [IsScalarTower R Rₘ Sₘ] [IsScalarTower R S Sₘ]

variable [IsLocalization M Rₘ] [IsLocalization (M.map (algebraMap R S)) Sₘ]

attribute [local elab_as_elim] Ideal.IsNilpotent.induction_on

include M

theorem FormallySmooth.of_isLocalization : FormallySmooth R Rₘ :=
  by
  constructor
  intro Q _ _ I e f
  have : ∀ x : M, IsUnit (algebraMap R Q x) := by
    intro x
    apply (IsNilpotent.isUnit_quotient_mk_iff ⟨2, e⟩).mp
    convert(IsLocalization.map_units Rₘ x).map f
    simp only [Ideal.Quotient.mk_algebraMap, AlgHom.commutes]
  let this : Rₘ →ₐ[R] Q :=
    { IsLocalization.lift this with commutes' := IsLocalization.lift_eq this }
  use this
  apply AlgHom.coe_ringHom_injective
  refine' IsLocalization.ringHom_ext M _
  ext
  simp
#align algebra.formally_smooth.of_is_localization Algebra.FormallySmooth.of_isLocalization

/-- This holds in general for epimorphisms. -/
theorem FormallyUnramified.of_isLocalization : FormallyUnramified R Rₘ :=
  by
  constructor
  intro Q _ _ I e f₁ f₂ e
  apply AlgHom.coe_ringHom_injective
  refine' IsLocalization.ringHom_ext M _
  ext
  simp
#align algebra.formally_unramified.of_is_localization Algebra.FormallyUnramified.of_isLocalization

theorem FormallyEtale.of_isLocalization : FormallyEtale R Rₘ :=
  FormallyEtale.iff_unramified_and_smooth.mpr
    ⟨FormallyUnramified.of_isLocalization M, FormallySmooth.of_isLocalization M⟩
#align algebra.formally_etale.of_is_localization Algebra.FormallyEtale.of_isLocalization

theorem FormallySmooth.localization_base [FormallySmooth R Sₘ] : FormallySmooth Rₘ Sₘ :=
  by
  constructor
  intro Q _ _ I e f
  letI := ((algebraMap Rₘ Q).comp (algebraMap R Rₘ)).toAlgebra
  letI : IsScalarTower R Rₘ Q := IsScalarTower.of_algebraMap_eq' rfl
  let f : Sₘ →ₐ[Rₘ] Q :=
    by
    refine' { formally_smooth.lift I ⟨2, e⟩ (f.restrict_scalars R) with commutes' := _ }
    intro r
    change
      (RingHom.comp (formally_smooth.lift I ⟨2, e⟩ (f.restrict_scalars R) : Sₘ →+* Q)
            (algebraMap _ _))
          r =
        algebraMap _ _ r
    congr 1
    refine' IsLocalization.ringHom_ext M _
    rw [RingHom.comp_assoc, ← IsScalarTower.algebraMap_eq, ← IsScalarTower.algebraMap_eq,
      AlgHom.comp_algebraMap]
  use f
  ext
  simp
#align algebra.formally_smooth.localization_base Algebra.FormallySmooth.localization_base

/-- This actually does not need the localization instance, and is stated here again for
consistency. See `algebra.formally_unramified.of_comp` instead.

 The intended use is for copying proofs between `formally_{unramified, smooth, etale}`
 without the need to change anything (including removing redundant arguments). -/
@[nolint unused_arguments]
theorem FormallyUnramified.localization_base [FormallyUnramified R Sₘ] : FormallyUnramified Rₘ Sₘ :=
  FormallyUnramified.of_comp R Rₘ Sₘ
#align algebra.formally_unramified.localization_base Algebra.FormallyUnramified.localization_base

theorem FormallyEtale.localization_base [FormallyEtale R Sₘ] : FormallyEtale Rₘ Sₘ :=
  FormallyEtale.iff_unramified_and_smooth.mpr
    ⟨FormallyUnramified.localization_base M, FormallySmooth.localization_base M⟩
#align algebra.formally_etale.localization_base Algebra.FormallyEtale.localization_base

theorem FormallySmooth.localization_map [FormallySmooth R S] : FormallySmooth Rₘ Sₘ :=
  by
  haveI : formally_smooth S Sₘ := formally_smooth.of_is_localization (M.map (algebraMap R S))
  haveI : formally_smooth R Sₘ := formally_smooth.comp R S Sₘ
  exact formally_smooth.localization_base M
#align algebra.formally_smooth.localization_map Algebra.FormallySmooth.localization_map

theorem FormallyUnramified.localization_map [FormallyUnramified R S] : FormallyUnramified Rₘ Sₘ :=
  by
  haveI : formally_unramified S Sₘ :=
    formally_unramified.of_is_localization (M.map (algebraMap R S))
  haveI : formally_unramified R Sₘ := formally_unramified.comp R S Sₘ
  exact formally_unramified.localization_base M
#align algebra.formally_unramified.localization_map Algebra.FormallyUnramified.localization_map

theorem FormallyEtale.localization_map [FormallyEtale R S] : FormallyEtale Rₘ Sₘ :=
  by
  haveI : formally_etale S Sₘ := formally_etale.of_is_localization (M.map (algebraMap R S))
  haveI : formally_etale R Sₘ := formally_etale.comp R S Sₘ
  exact formally_etale.localization_base M
#align algebra.formally_etale.localization_map Algebra.FormallyEtale.localization_map

end Localization

end Algebra


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Factorial
-/
import data.nat.div

namespace nat
definition fact : nat → nat
| 0        := 1
| (succ n) := (succ n) * fact n

lemma fact_zero : fact 0 = 1 :=
rfl

lemma fact_one : fact 1 = 1 :=
rfl

lemma fact_succ (n) : fact (succ n) = succ n * fact n :=
rfl

lemma fact_pos : ∀ n, fact n > 0
| 0        := zero_lt_one
| (succ n) := mul_pos !succ_pos (fact_pos n)

lemma fact_ne_zero (n : ℕ) : fact n ≠ 0 := ne_of_gt !fact_pos

lemma dvd_fact : ∀ {m n}, m > 0 → m ≤ n → m ∣ fact n
| m 0        h₁ h₂ := absurd h₁ (not_lt_of_ge h₂)
| m (succ n) h₁ h₂ :=
  begin
    rewrite fact_succ,
    cases (eq_or_lt_of_le h₂) with he hl,
      {subst m, apply dvd_mul_right},
      {have aux : m ∣ fact n, from dvd_fact h₁ (le_of_lt_succ hl),
       apply dvd_mul_of_dvd_right aux}
  end

lemma fact_le {m n} : m ≤ n → fact m ≤ fact n :=
begin
  induction n with n ih,
   {intro h,
    have meq0 : m = 0, from eq_zero_of_le_zero h,
    subst m},
   {intro m_le_succ_n,
    cases (eq_or_lt_of_le m_le_succ_n) with h₁ h₂,
      {subst m},
      {transitivity (fact n),
        exact ih (le_of_lt_succ h₂),
        rewrite [fact_succ, -one_mul (fact n) at {1}],
        exact nat.mul_le_mul (succ_le_succ (zero_le n)) !le.refl}}
end
end nat


import data.nat.choose
import data.set
import data.set.finite
import data.multiset
import data.list
import data.list.perm

/- Collaboration between
   Travis Hance (thance)
   Katherine Cordwell (kcordwell)
-/

/-
    Machinery for bijective proofs.
    `has_card` is a Prop that indicates a set is finite
    and has a certain cardinality.

    Below are several theorems for using a bijection
    between multiple sets to establish a relation between their
    sizes. (Both Travis and Katherine's focus)
-/

def has_card {α : Type} (s : set α) (n : ℕ) : Prop :=
    ∃ l : (list α) , list.length l = n ∧ (∀ x : α , x ∈ s ↔ x ∈ l)
            ∧ list.nodup l

theorem card_bijection
    {α : Type} {β : Type}
        (A : set α) (B : set β) (a : ℕ)
        (f : (α → β)) :
    (∀ (x:α) , x ∈ A → f x ∈ B) →
    (∀ y , y ∈ B → ∃ x , x ∈ A ∧ f x = y) →
    (∀ x x' , x ∈ A → x' ∈ A → f x = f x' → x = x') →
    has_card A a →
    has_card B a := begin
    assume A1 A2 A3 h4,
    simp[has_card],
    have exh: ∃ L: (list α) , list.length L = a ∧ (∀ x : α , x ∈ A ↔ x ∈ L)
            ∧ list.nodup L, from h4,
    apply exists.elim exh,
    {
        assume L, assume hL: list.length L = a ∧ (∀ x : α , x ∈ A ↔ x ∈ L)
            ∧ list.nodup L,
        have nodupL: list.nodup L, from and.right (and.right hL),
        have iffL: (∀ x : α , x ∈ A ↔ x ∈ L), from and.left (and.right hL),
        have lengthHyp: list.length L = a, from and.left hL,
        let fL: list β := list.map f L,
        have B1: list.length fL = a, from
            begin
                simp[list.length_map f L, lengthHyp]
            end,
        have B2: (∀ x : β , x ∈ B ↔ x ∈ fL), from
            begin
                intros,
                have h1: x ∈ B → x ∈ fL,
                    begin
                        intro h,
                        have h2: ∃ y, y ∈ A ∧ f y = x, from A2 x h,
                        have h3: ∃ y, y ∈ L ∧ f y = x,
                            begin
                                apply exists.elim h2,
                                assume y, assume hy,
                                have hy1: y ∈ L, from iff.elim_left (iffL y) (and.left hy),
                                exact exists.intro y (and.intro hy1 (and.right hy))
                            end,
                        have h4: x ∈ list.map f L, from (iff.elim_right list.mem_map) h3,
                        simp[h3]
                    end ,
                have h2: x ∈ fL → x ∈ B,
                    begin
                        intro h,
                        have h1: ∃ y, y ∈ L ∧ f y = x, from list.exists_of_mem_map h,
                        have h2: ∃ y, y ∈ A ∧ f y = x,
                            begin
                                apply exists.elim h1,
                                assume y, assume hy,
                                have hy1: y ∈ A, from iff.elim_right (iffL y) (and.left hy),
                                exact exists.intro y (and.intro hy1 (and.right hy))
                            end,
                        apply exists.elim h2,
                        assume y, assume hy,
                        have h3: f y ∈ B, from A1 y (and.left hy),
                        have h4: f y = x, from and.right hy,
                        rw h4 at h3,
                        exact h3
                    end,
                exact iff.intro h1 h2
            end,
        have h: ∀ x ∈ A, ∀ y ∈ A, f x = f y → x = y, begin intros, exact A3 x y H H_1 a_1 end,
        have h1: ∀ x ∈ L, ∀ y ∈ L, f x = f y → x = y,
            begin
                intros, have h1: x ∈ A, from iff.elim_right(iffL x) H,
                have h2: y ∈ A, from iff.elim_right(iffL y) H_1,
                exact A3 x y h1 h2 a_1
            end,
        have h2: list.nodup (list.map f L), from list.nodup_map_on h1 nodupL,
        have B3: list.nodup fL, from h2,
        exact ⟨fL, and.intro B1 (and.intro B2 B3)⟩,
    }
    end

theorem card_split
    {α : Type} (A : set α) (B : set α) (C : set α) (b : ℕ) (c : ℕ) :
    (∀ x , x ∈ B → x ∈ A) →
    (∀ x , x ∈ C → x ∈ A) →
    (∀ x , x ∈ A → (x ∈ B ∨ x ∈ C)) →
    (∀ x , ¬ (x ∈ B ∧ x ∈ C)) →
    has_card B b ->
    has_card C c ->
    has_card A (b+c) :=
begin
    intros,
    rw [has_card] at * ,
    cases a_4, cases a_5 ,
    rename a_4_w l1 , rename a_5_w l2 ,
    cases a_4_h , cases a_5_h ,
    cases a_4_h_right, cases a_5_h_right,
    existsi (l1 ++ l2) ,
    split ,
    simp , subst b , subst c ,
    split ,
    intros ,
    split ,
    intros ,
    have b_or_c := a_2 x a_4 ,
    cases b_or_c ,
    have x_in_l1 := (iff.elim_left (a_4_h_right_left x)) b_or_c ,
    simp , left , assumption ,
    have x_in_l2 := (iff.elim_left (a_5_h_right_left x)) b_or_c ,
    simp , right , assumption ,
    intros ,
    simp at a_4 ,
    cases a_4 ,
    exact (a x (iff.elim_right (a_4_h_right_left x) a_4)) ,
    exact (a_1 x (iff.elim_right (a_5_h_right_left x) a_4)) ,
    apply list.nodup_append_of_nodup , assumption, assumption ,
    rw list.disjoint_iff_ne ,
    intros , apply not.intro , intros ,
    rename b_1 x , rw a_5 at * ,
    have x_in_b := (iff.elim_right (a_4_h_right_left x) H) ,
    have x_in_c := (iff.elim_right (a_5_h_right_left x) H_1) ,
    have x_in_b_and_x_in_c := and.intro x_in_b x_in_c ,
    have not_x_in_b_and_x_in_c := a_3 x ,
    contradiction ,
end

theorem card_split_map
    {α : Type} {β : Type} {γ : Type}
        (A : set α) (B : set β) (C : set γ) (b : ℕ) (c : ℕ)
        (f : (β → α)) (g : (γ → α)) :
    (∀ y , y ∈ B → f y ∈ A) →
    (∀ z , z ∈ C → g z ∈ A) →
    (∀ x , x ∈ A → (∃ y:β , y ∈ B ∧ f y = x) ∨ (∃ z:γ , z ∈ C ∧ g z = x)) →
    (∀ y z , (y ∈ B → z ∈ B → f y = f z → y = z )) →
    (∀ y z , (y ∈ C → z ∈ C → g y = g z → y = z )) →
    (∀ y z , (y ∈ B → z ∈ C → f y = g z → false)) →
    has_card B b ->
    has_card C c ->
    has_card A (b+c) :=
begin
    intros ,
    apply (card_split A
        { x : α | ∃ y , y ∈ B ∧ f y = x }
        { x : α | ∃ z , z ∈ C ∧ g z = x }
        b c) ,
    {
        intros , simp at a_8 , cases a_8 , rename a_8_w y ,
        cases a_8_h , subst x , apply (a y) , assumption ,
    },
    {
        intros , simp at a_8 , cases a_8 , rename a_8_w z ,
        cases a_8_h , subst x , apply (a_1 z) , assumption ,
    },
    {
        simp, intros, apply (a_2 x) , assumption ,
    },
    {
        intros , apply not.intro , simp , intros ,
        exact (a_5 x_1 x_2 a_8 a_10 (begin
            rw a_9 , rw a_11 ,
        end)) ,
    },
    {
        apply (card_bijection
            B
            {x : α | ∃ (y : β), y ∈ B ∧ f y = x}
            b f
        ),
        intros , simp , existsi x , split, assumption, trivial,
        intros , simp at a_8 , cases a_8 , existsi a_8_w , assumption ,
        intros , exact (a_3 x x' a_8 a_9 a_10) ,
        assumption ,
    },
    {
        apply (card_bijection
            C
            {x : α | ∃ (z : γ), z ∈ C ∧ g z = x}
            c g
        ),
        intros , simp , existsi x , split, assumption, trivial,
        intros , simp at a_8 , cases a_8 , existsi a_8_w , assumption ,
        intros , exact (a_4 x x' a_8 a_9 a_10) ,
        assumption ,
    },
end

theorem card_0
    {α : Type} (A : set α) :
    (∀ (y:α) , y ∈ A → false) →
    has_card A 0 :=
    begin
    intro h,
    have h0: list.length ([]: list α) = 0, by rw[list.length],
    have h1: (∀ x : α , x ∈ A ↔ x ∈ ([]: list α)),
        by {intro x, split,
            {intro xh, apply h x xh},
            intro xh, simp at xh, contradiction},
    have h2: list.nodup ([]: list α), by simp,
    exact ⟨([]: list α), and.intro h0 (and.intro h1 h2)⟩
    end

theorem card_1
    {α : Type} (A : set α) (x : α) :
    (x ∈ A) →
    (∀ (y:α) , y ∈ A → x = y) →
    has_card A 1 :=
    begin
    intro h,
    intro hall,
    have h0: list.length (x::[]) = 1, by simp,
    have h1: (∀ z : α , z ∈ A ↔ z ∈ (x::[])),
        by {intro z, split,
            {intro zh, have newh: x = z, by apply hall z zh, simp *},
            intro zh, simp at zh, simp *},
    have h2: list.nodup (x::[]), by simp,
    exact ⟨(x::[]), and.intro h0 (and.intro h1 h2)⟩
    end

theorem set_induct
    {α : Type} (A : set α) (a:ℕ) :
    has_card A (a+1) →
    (∃ (x:α) (A':set α) ,
        has_card A' a ∧
        ¬ (x ∈ A') ∧
        A = { x' : α | x' ∈ A' ∨ x' = x }
    ) :=
begin
    intros , rw [has_card] at a_1 , cases a_1 , rename a_1_w l ,
    cases a_1_h ,
    cases l , simp at a_1_h_left , contradiction ,
    existsi l_hd ,
    existsi { x : α | x ∈ A ∧ ¬ (x = l_hd)} ,
    split ,
    {
        rw [has_card] , existsi l_tl ,
        split , simp at a_1_h_left , rw add_comm at a_1_h_left ,
        rw add_right_cancel_iff at a_1_h_left , assumption ,
        cases a_1_h_right ,
        split ,
        intros ,
        split ,
        simp , intros ,
        have x_in_l := iff.elim_left (a_1_h_right_left x) a_1,
        simp at x_in_l , cases x_in_l , contradiction , assumption ,
        simp , intros ,
        split ,
        exact (iff.elim_right (a_1_h_right_left x) (begin
                simp, right, assumption,
            end)),
        rw [list.nodup_cons] at a_1_h_right_right ,
        apply not.intro , intros , rw a_2 at * , cases a_1_h_right_right ,
        contradiction ,
        rw [list.nodup_cons] at a_1_h_right_right ,
        cases a_1_h_right_right , assumption ,
    },
    split ,
    {
        simp ,
    },
    {
        apply set.ext ,
        intros ,
        split ,
        {
            intros , simp ,
            /- TODO don't actually need classical here
               (could prove this with x ∈ l_hd :: l_tl
               and list.nodup (l_hd :: l_tl) instead) -/
            have c := classical.em (x = l_hd) ,
            cases c ,
            right , assumption ,
            left , split , assumption, assumption,
        },
        {
            simp , intros ,
            cases a_1 ,
            cases a_1 , assumption ,
            cases a_1_h_right ,
            exact (iff.elim_right (a_1_h_right_left x) (begin
                rw a_1 , simp ,
            end)),
        }
    }
end

theorem card_product
    {α : Type} {β : Type} {γ : Type}
        (A : set α) (B : set β) (C : set γ) (a : ℕ) (b : ℕ)
        (f : α → β → γ) :
    (∀ x y , x ∈ A → y ∈ B → f x y ∈ C) →
    (∀ z , z ∈ C → ∃ x y , x ∈ A ∧ y ∈ B ∧ f x y = z) →
    (∀ (x:α) (y:β) (x':α) (y':β) , x ∈ A → x' ∈ A → y ∈ B → y' ∈ B →
            f x y = f x' y' → x = x' ∧ y = y') →
    has_card A a →
    has_card B b →
    has_card C (a * b) :=
begin
    revert C , revert A , induction a ,
    {
        intros , simp , apply card_0 ,
        intros ,
        have h := a_1 y a_5 ,
        cases h ,
        cases h_h ,
        cases h_h_h ,
        rename h_w a' , have t : a' ∈ A := by assumption ,
        rw [has_card] at a_3 ,
        cases a_3 ,
        cases a_3_h ,
        rename a_3_w l ,
        cases l ,
        have m := a_3_h_right.left a' ,
        simp at m , contradiction ,
        simp at a_3_h_left , contradiction ,
    },
    {
        intros ,
        have h := set_induct A a_n a_3 ,
        cases h , cases h_h , rename h_w new_x , rename h_h_w A' ,
        cases h_h_h , cases h_h_h_right , rename h_h_h_right_right A_eq ,
        have s_eq : (nat.succ a_n = a_n + 1) := rfl ,
        rw s_eq , rw add_mul , simp ,

        have A'_to_A : (∀ x , x ∈ A' → x ∈ A) := (λ x , λ x_in_A' ,
            begin
                rw A_eq , simp , left , assumption ,
            end
        ) ,
        have new_x_in_A : new_x ∈ A := begin
            rw A_eq , simp ,
        end ,

        have ih := a_ih A' { z : γ | ∃ x y, x ∈ A' ∧ y ∈ B ∧ f x y = z }
            (
                λ x:α , λ y:β , λ x_in_A' , λ y_in_B , (begin
                    simp , existsi x , split , assumption ,
                    existsi y , split , assumption , trivial ,
                end)
            ) (λ z:γ , begin
                simp , intros , rename x_1 y ,
                existsi x , split , assumption ,
                existsi y , split , assumption , assumption ,
            end) (
                λ (x : α) (y : β) (x' : α) (y' : β) ,
                λ x_in_A' , λ x'_in_A' , λ y_in_B , λ y'_in_B' , λ f_eq ,
                    a_2 x y x' y' (A'_to_A x x_in_A') (A'_to_A x' x'_in_A') y_in_B y'_in_B' f_eq
            ) (begin
                by assumption
            end) (begin
                by assumption
            end),

        rw add_comm ,
        apply (card_split_map C
             { z : γ | ∃ x y, x ∈ A' ∧ y ∈ B ∧ f x y = z }
             B
             (a_n * b) b
             (λ z : γ , z)
             (λ y : β , f new_x y)) ,
        {
            intros , simp , simp at a_5 ,
            cases a_5 , cases a_5_h , cases a_5_h_right ,
            cases a_5_h_right_h ,
            rw <- a_5_h_right_h_right ,
            apply (a a_5_w a_5_h_right_w) ,
            apply A'_to_A, assumption,
            assumption,
        },
        {
            intros , simp ,
            apply (a new_x z) ,
            rw A_eq , simp , assumption ,
        },
        {
            intros ,
            rename x z ,
            have q := a_1 z a_5 ,
            cases q ,
            cases q_h ,
            rename q_w x , rename q_h_w y ,
            cases q_h_h , rw A_eq at q_h_h_left , simp at q_h_h_left ,
            cases q_h_h_right ,
            cases q_h_h_left ,
            {
                left , existsi z , simp , existsi x , split , assumption ,
                existsi y , split , assumption, assumption ,
            },
            {
                right , existsi y , split , assumption , simp ,
                rw <- q_h_h_left , assumption ,
            },
        },
        {
            intros , simp at a_7 , assumption ,
        },
        {
            intros , simp at a_7 ,
            exact (a_2 new_x y new_x z new_x_in_A new_x_in_A a_5 a_6 a_7).right,
        },
        {
            intros , simp at a_7 , simp at a_5 , cases a_5 ,
            rename a_5_w x , cases a_5_h , cases a_5_h_right ,
            rename a_5_h_right_w z' , cases a_5_h_right_h ,
            rw a_7 at * ,
            have x_eq_new_x : (x = new_x) := (a_2 x z' new_x z (A'_to_A x a_5_h_left) new_x_in_A a_5_h_right_h_left a_6 a_5_h_right_h_right).left ,
            rw x_eq_new_x at * , contradiction ,
        },
        {
            assumption ,
        },
        {
            assumption ,
        },
    }
end

theorem has_card_nats_lt (n : ℕ) :
    has_card { i : ℕ | i < n } n :=
begin
    rw [has_card] , existsi (list.range n) ,
    split ,
    {
        apply list.length_range ,
    },
    split ,
    {
        intros , split ,
        {
            simp ,
        },
        {
            simp ,
        }
    },
    {
        apply list.nodup_range ,
    }
end

theorem card_product_nat
    {α : Type} {γ : Type}
        (A : set α) (b : ℕ) (C : set γ) (a : ℕ)
        (f : α → ℕ → γ) :
    (∀ x y , x ∈ A → 0 ≤ y → y < b → f x y ∈ C) →
    (∀ z , z ∈ C → ∃ x y , x ∈ A ∧ 0 ≤ y ∧ y < b ∧ f x y = z) →
    (∀ (x:α) (y:ℕ) (x':α) (y':ℕ) ,
            x ∈ A → x' ∈ A → 0 ≤ y → y < b → 0 ≤ y' → y' < b →
            f x y = f x' y' → x = x' ∧ y = y') →
    has_card A a →
    has_card C (a * b) :=
begin
    intros ,
    apply (card_product A { i : ℕ | i < b } C a b
        (λ x , λ i , f x i)) ,
    {
        intros , simp , simp at a_6 ,
        exact (a_1 x y a_5 (by simp) a_6) ,
    },
    {
        intros , simp ,
        have h := a_2 z a_5 ,
        cases h , cases h_h , rename h_w x , rename h_h_w y ,
        cases h_h_h , cases h_h_h_right , cases h_h_h_right_right ,
        existsi x , split , assumption , existsi y , split , assumption ,
        assumption ,
    },
    {
        exact (
            λ (x : α) (y : ℕ) (x' : α) (y' : ℕ),
            λ (x_in_A : x ∈ A) ,
            λ (x'_in_A : x' ∈ A) ,
            λ (y_in : y ∈ {i : ℕ | i < b}) ,
            λ (y'_in : y' ∈ {i : ℕ | i < b}) ,
            begin
                simp , intros ,
                simp at y_in ,
                simp at y'_in ,
                exact (a_3 x y x' y' x_in_A x'_in_A (by simp) y_in (by simp) y'_in a_5) ,
            end
        )
    },
    {
        assumption ,
    },
    {
        apply has_card_nats_lt ,
    },
end

theorem cardinality_unique {α : Type} (A : set α) (a:ℕ) (b:ℕ) :
    has_card A a → has_card A b → a = b := begin
    intro h1,
    intro h2,
    simp[has_card] at h1,
    simp[has_card] at h2,
    apply exists.elim h1,
    assume a1 l1,
    have l1iff: ∀ x: α, x ∈ A ↔ x ∈ a1, from and.left (and.right l1),
    have l1len: list.length a1 = a, from and.left l1,
    have l1nodup: list.nodup a1, from and.right (and.right l1),
    apply exists.elim h2,
    assume a2 l2,
    have l2iff: ∀ x: α, x ∈ A ↔ x ∈ a2, from and.left (and.right l2),
    have l2len: list.length a2 = b, from and.left l2,
    have l2nodup: list.nodup a2, from and.right (and.right l2),
    have h1: ∀ x: α, x ∈ a1 ↔ x ∈ a2,
        begin
            intro x,
            have h2: x ∈ a1 → x ∈ a2,
                begin
                    intro hnew,
                    have hA: x ∈ A, from iff.elim_right (l1iff x) hnew,
                    exact iff.elim_left (l2iff x) hA
                end,
            have h3: x ∈ a2 → x ∈ a1,
                begin
                    intro hnew,
                    have hA: x ∈ A, from iff.elim_right (l2iff x) hnew,
                    exact iff.elim_left (l1iff x) hA
                end,
            exact iff.intro h2 h3
        end,
    have permh: a1 ~ a2, from (iff.elim_right (list.perm_ext l1nodup l2nodup)) h1,
    have lenh: list.length a1 = list.length a2, from list.perm_length permh,
    rw l1len at lenh,
    rw l2len at lenh,
    exact lenh
    end

/-
    Here we define the set of boolean sequences of length n with
    exactly k elements set to `tt`.
    We show that the cardinality of this set is `choose n k`.
    (theorem `has_card_set_n_choose_k`).
-/

def count_tt : (list bool) → (ℕ)
| [] := 0
| (ff :: l) := count_tt l
| (tt :: l) := count_tt l + 1

def set_n_choose_k (n : ℕ) (k : ℕ) : set (list bool) :=
    { l : list bool | list.length l = n ∧ count_tt l = k }

def all_ff : (ℕ) → (list bool)
| 0 := []
| (n + 1) := ff :: (all_ff n)

theorem is_all_ff : ∀ x : (list bool),
    count_tt x = 0 → x = all_ff (list.length x)
    | [] := by simp[count_tt, all_ff]
    | (tt :: l) := by simp[count_tt]
    | (ff :: l) := λ h: count_tt (ff::l) = 0,
    have h0: 0 = count_tt (ff::l), by simp[refl, h],
    have h1: count_tt (ff::l) = count_tt l, by simp[count_tt],
    have h2: count_tt l = 0, by simp[h0, h1, refl],
    have h3: l = all_ff (list.length l), by apply (is_all_ff l) h2,
    have h5: list.length (ff :: l) = list.length l + 1, by simp[list.length],
    have h6: all_ff (list.length (ff :: l))
        = all_ff(list.length l + 1), by simp[*],
    begin
    have h7:  all_ff (list.length (ff :: l)) = ff :: l, by
    {calc
        all_ff (list.length (ff :: l)) = all_ff (list.length l + 1): by simp[*]
                            ... = ff::(all_ff (list.length l)): by rw[all_ff]
                            ... = ff :: l : by rw[←h3]},
    apply eq.symm h7
    end

theorem length_all_ff : ∀ n : ℕ ,
    list.length (all_ff n) = n
    | 0 := by simp[all_ff, refl]
    | (n + 1) := by simp[all_ff, list.length_cons, length_all_ff n]

theorem count_tt_all_ff : ∀ n : ℕ ,
    count_tt (all_ff n) = 0
    | 0 := by simp[count_tt, all_ff, refl]
    | (n+1) :=
        begin
            calc
            count_tt (all_ff (n + 1)) = count_tt (ff:: (all_ff n)): by simp[all_ff]
                                ... = count_tt(all_ff n): by simp[count_tt]
                                ... = 0: by simp[count_tt_all_ff n]
        end

theorem eq_of_add_1 : ∀ n : ℕ , ∀ m : ℕ ,
    (n + 1) = (m + 1) -> n = m := by simp[refl]

theorem has_card_set_n_choose_k : ∀ (n : ℕ) (k : ℕ) ,
    has_card (set_n_choose_k n k) (choose n k)
| n 0 :=
    begin
        simp , rw [set_n_choose_k] ,
        apply (card_1
            {l : list bool | list.length l = n ∧ count_tt l = 0}
            (all_ff n)) ,
        simp , split , apply length_all_ff , apply count_tt_all_ff ,
        intros , simp at a , cases a , subst n , symmetry ,
        apply is_all_ff , assumption ,
    end
| 0 (k + 1) :=
    begin
        simp [set_n_choose_k] ,
        apply (card_0
            {l : list bool | list.length l = 0 ∧ count_tt l = k + 1}) ,
        intros , simp at a , cases a ,
        cases y , rw [count_tt] at a_right , contradiction ,
        simp at a_left , contradiction ,
    end
| (n+1) (k+1) :=
    begin
        simp [set_n_choose_k] ,
        apply (card_split_map
            ({l : list bool | list.length l = n + 1 ∧ count_tt l = k + 1})
            ({l : (list bool) | list.length l = n ∧ count_tt l = k})
            ({l : (list bool) | list.length l = n ∧ count_tt l = k+1})
            (choose n k)
            (choose n (k+1))
            (λ r : (list bool) , ((tt :: r) : list bool))
            (λ r : (list bool) , ((ff :: r) : list bool))
        ) ,
        {
            intros , simp , simp at a , cases a , split ,
            rw a_left, rw add_comm ,
            simp [count_tt] , assumption ,
        },
        {
            intros , simp , simp at a , cases a , split ,
            rw a_left , rw add_comm ,
            simp [count_tt] , assumption ,
        },
        {
            simp , intros ,
            cases x , trivial ,
            cases x_hd ,
            {
                right , existsi x_tl ,
                split , split ,
                simp at a , rw [@nat.add_comm 1 _] at a ,
                apply eq_of_add_1 , assumption ,
                simp [count_tt] at a_1 , assumption ,
                trivial ,
            },
            {
                left , existsi x_tl ,
                split , split ,
                simp at a , rw [@nat.add_comm 1 _] at a ,
                apply eq_of_add_1 , assumption ,
                simp [count_tt] at a_1 , assumption ,
                trivial ,
            }
        },
        {
            intros ,
            simp at a_2 ,
            assumption ,
        },
        {
            intros ,
            simp at a_2 ,
            assumption ,
        },
        {
            intros ,
            simp at a_2 ,
            assumption ,
        },
        {
            apply has_card_set_n_choose_k ,
        },
        {
            apply has_card_set_n_choose_k ,
        },
    end


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

Define the p-adic numbers (rationals) ℚ_p as the completion of ℚ wrt the p-adic norm.
Show that the p-adic norm extends to ℚ_p, that ℚ is embedded in ℚ_p, and that ℚ_p is complete
-/

import data.real.cau_seq_completion topology.metric_space.cau_seq_filter
import algebra.archimedean analysis.normed_space.basic
import padics.padic_norm norm_cast
noncomputable theory
local attribute [instance, priority 1] classical.prop_decidable

open nat multiplicity padic_norm cau_seq cau_seq.completion metric

theorem nat.find_le {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q]
    (h : ∀ n, q n → p n) (hp : ∃ n, p n) (hq : ∃ n, q n) :
    nat.find hp ≤ nat.find hq :=
nat.find_min' _ ((h _) (nat.find_spec hq))

@[norm_cast]
theorem int.coe_nat_multiplicity (a b : ℕ) :
    multiplicity a b = multiplicity (a : ℤ) (b : ℤ) :=
begin
    apply roption.ext',
    { repeat {rw [← finite_iff_dom, finite_def]},
      norm_cast, simp },
    { intros h1 h2,
      apply _root_.le_antisymm; { apply nat.find_le, norm_cast, simp }}
end

@[reducible] def padic_seq (p : ℕ) [p.prime] := cau_seq _ (padic_norm p)

namespace padic_seq

section
variables {p : ℕ} [nat.prime p]

lemma stationary {f : cau_seq ℚ (padic_norm p)} (hf : ¬ f ≈ 0) :
  ∃ N, ∀ m n, m ≥ N → n ≥ N → padic_norm p (f n) = padic_norm p (f m) :=
have ∃ ε > 0, ∃ N1, ∀ j ≥ N1, ε ≤ padic_norm p (f j),
  from cau_seq.abv_pos_of_not_lim_zero $ not_lim_zero_of_not_congr_zero hf,
let ⟨ε, hε, N1, hN1⟩ := this,
    ⟨N2, hN2⟩ := cau_seq.cauchy₂ f hε in
⟨ max N1 N2,
  λ n m hn hm,
  have padic_norm p (f n - f m) < ε, from hN2 _ _ (max_le_iff.1 hn).2 (max_le_iff.1 hm).2,
  have padic_norm p (f n - f m) < padic_norm p (f n),
    from lt_of_lt_of_le this $ hN1 _ (max_le_iff.1 hn).1,
  have  padic_norm p (f n - f m) < max (padic_norm p (f n)) (padic_norm p (f m)),
    from lt_max_iff.2 (or.inl this),
  begin
    by_contradiction hne,
    rw ←padic_norm.neg p (f m) at hne,
    have hnam := add_eq_max_of_ne p hne,
    rw [padic_norm.neg, max_comm] at hnam,
    rw ←hnam at this,
    apply _root_.lt_irrefl _ (by simp at this; exact this)
  end ⟩

def stationary_point {f : padic_seq p} (hf : ¬ f ≈ 0) : ℕ :=
classical.some $ stationary hf

lemma stationary_point_spec {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∀ {m n}, m ≥ stationary_point hf → n ≥ stationary_point hf →
    padic_norm p (f n) = padic_norm p (f m) :=
classical.some_spec $ stationary hf

def norm (f : padic_seq p) : ℚ :=
if hf : f ≈ 0 then 0 else padic_norm p (f (stationary_point hf))

lemma norm_zero_iff (f : padic_seq p) : f.norm = 0 ↔ f ≈ 0 :=
begin
  constructor,
  { intro h,
    by_contradiction hf,
    unfold norm at h, split_ifs at h,
    apply hf,
    intros ε hε,
    existsi stationary_point hf,
    intros j hj,
    have heq := stationary_point_spec hf (le_refl _) hj,
    simpa [h, heq] },
  { intro h,
    simp [norm, h] }
end

end

section embedding
open cau_seq
variables {p : ℕ} [nat.prime p]

lemma equiv_zero_of_val_eq_of_equiv_zero {f g : padic_seq p}
  (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) (hf : f ≈ 0) : g ≈ 0 :=
λ ε hε, let ⟨i, hi⟩ := hf _ hε in
⟨i, λ j hj, by simpa [h] using hi _ hj⟩

lemma norm_nonzero_of_not_equiv_zero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  f.norm ≠ 0 :=
hf ∘ f.norm_zero_iff.1

lemma norm_eq_norm_app_of_nonzero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∃ k, f.norm = padic_norm p k ∧ k ≠ 0 :=
have heq : f.norm = padic_norm p (f $ stationary_point hf), by simp [norm, hf],
⟨f $ stationary_point hf, heq,
  λ h, norm_nonzero_of_not_equiv_zero hf (by simpa [h] using heq)⟩

lemma not_lim_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ lim_zero (const (padic_norm p) q) :=
λ h', hq $ const_lim_zero.1 h'

lemma not_equiv_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ (const (padic_norm p) q) ≈ 0 :=
λ h : lim_zero (const (padic_norm p) q - 0), not_lim_zero_const_of_nonzero hq $ by simpa using h

lemma norm_nonneg (f : padic_seq p) : f.norm ≥ 0 :=
if hf : f ≈ 0 then by simp [hf, norm]
else by simp [norm, hf, padic_norm.nonneg]

lemma lift_index_left_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v2 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max (stationary_point hf) (max v2 v3))) :=
let i := max (stationary_point hf) (max v2 v3) in
begin
  apply stationary_point_spec hf,
  { apply le_max_left },
  { apply le_refl }
end

lemma lift_index_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max v1 (max (stationary_point hf) v3))) :=
let i := max v1 (max (stationary_point hf) v3) in
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_left _ v3 },
    { apply le_max_right } },
  { apply le_refl }
end

lemma lift_index_right {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v2 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max v1 (max v2 (stationary_point hf)))) :=
let i := max v1 (max v2 (stationary_point hf)) in
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_right v2 },
    { apply le_max_right } },
  { apply le_refl }
end

end embedding

end padic_seq

section
open padic_seq

meta def index_simp_core (hh hf hg : expr) (at_ : interactive.loc := interactive.loc.ns [none]) : tactic unit :=
do [v1, v2, v3] ← [hh, hf, hg].mmap
     (λ n, tactic.mk_app ``stationary_point [n] <|> return n),
   e1 ← tactic.mk_app ``lift_index_left_left [hh, v2, v3] <|> return `(true),
   e2 ← tactic.mk_app ``lift_index_left [hf, v1, v3] <|> return `(true),
   e3 ← tactic.mk_app ``lift_index_right [hg, v1, v2] <|> return `(true),
   sl ← [e1, e2, e3].mfoldl (λ s e, simp_lemmas.add s e) simp_lemmas.mk,
   when at_.include_goal (tactic.simp_target sl),
   hs ← at_.get_locals, hs.mmap' (tactic.simp_hyp sl [])

/--
  This is a special-purpose tactic that lifts padic_norm (f (stationary_point f)) to
  padic_norm (f (max _ _ _)).
-/
meta def tactic.interactive.padic_index_simp (l : interactive.parse interactive.types.pexpr_list)
  (at_ : interactive.parse interactive.types.location) : tactic unit :=
do [h, f, g] ← l.mmap tactic.i_to_expr,
   index_simp_core h f g at_
end

namespace padic_seq
section embedding

open cau_seq
variables {p : ℕ} [hp : nat.prime p]
include hp

lemma norm_mul (f g : padic_seq p) : (f * g).norm = f.norm * g.norm :=
if hf : f ≈ 0 then
  have hg : f * g ≈ 0, from mul_equiv_zero' _ hf,
  by simp [hf, hg, norm]
else if hg : g ≈ 0 then
  have hf : f * g ≈ 0, from mul_equiv_zero _ hg,
  by simp [hf, hg, norm]
else
  have hfg : ¬ f * g ≈ 0, by apply mul_not_equiv_zero; assumption,
  begin
    unfold norm,
    split_ifs,
    padic_index_simp [hfg, hf, hg],
    apply padic_norm.mul
  end

lemma eq_zero_iff_equiv_zero (f : padic_seq p) : mk f = 0 ↔ f ≈ 0 :=
mk_eq

lemma ne_zero_iff_nequiv_zero (f : padic_seq p) : mk f ≠ 0 ↔ ¬ f ≈ 0 :=
not_iff_not.2 (eq_zero_iff_equiv_zero _)

lemma norm_const (q : ℚ) : norm (const (padic_norm p) q) = padic_norm p q :=
if hq : q = 0 then
  have (const (padic_norm p) q) ≈ 0,
    by simp [hq]; apply setoid.refl (const (padic_norm p) 0),
  by subst hq; simp [norm, this]
else
  have ¬ (const (padic_norm p) q) ≈ 0, from not_equiv_zero_const_of_nonzero hq,
  by simp [norm, this]

lemma norm_image (a : padic_seq p) (ha : ¬ a ≈ 0) :
  (∃ (n : ℤ), a.norm = ↑p ^ (-n)) :=
let ⟨k, hk, hk'⟩ := norm_eq_norm_app_of_nonzero ha in
by simpa [hk] using padic_norm.image p hk'

lemma norm_one : norm (1 : padic_seq p) = 1 :=
have h1 : ¬ (1 : padic_seq p) ≈ 0, from one_not_equiv_zero _,
by simp [h1, norm, hp.gt_one]

private lemma norm_eq_of_equiv_aux {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g)
  (h : padic_norm p (f (stationary_point hf)) ≠ padic_norm p (g (stationary_point hg)))
  (hgt : padic_norm p (f (stationary_point hf)) > padic_norm p (g (stationary_point hg))) :
  false :=
begin
  have hpn : padic_norm p (f (stationary_point hf)) - padic_norm p (g (stationary_point hg)) > 0,
    from sub_pos_of_lt hgt,
  cases hfg _ hpn with N hN,
  let i := max N (max (stationary_point hf) (stationary_point hg)),
  have hi : i ≥ N, from le_max_left _ _,
  have hN' := hN _ hi,
  padic_index_simp [N, hf, hg] at hN' h hgt,
  have hpne : padic_norm p (f i) ≠ padic_norm p (-(g i)),
    by rwa [ ←padic_norm.neg p (g i)] at h,
  let hpnem := add_eq_max_of_ne p hpne,
  have hpeq : padic_norm p ((f - g) i) = max (padic_norm p (f i)) (padic_norm p (g i)),
  { rwa padic_norm.neg at hpnem },
  rw [hpeq, max_eq_left_of_lt hgt] at hN',
  have : padic_norm p (f i) < padic_norm p (f i),
  { apply lt_of_lt_of_le hN', apply sub_le_self, apply padic_norm.nonneg },
  exact lt_irrefl _ this
end

private lemma norm_eq_of_equiv {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (g (stationary_point hg)) :=
begin
  by_contradiction h,
  cases (decidable.em (padic_norm p (f (stationary_point hf)) >
          padic_norm p (g (stationary_point hg))))
      with hgt hngt,
  { exact norm_eq_of_equiv_aux hf hg hfg h hgt },
  { apply norm_eq_of_equiv_aux hg hf (setoid.symm hfg) (ne.symm h),
    apply lt_of_le_of_ne,
    apply le_of_not_gt hngt,
    apply h }
end

theorem norm_equiv {f g : padic_seq p} (hfg : f ≈ g) : f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from setoid.trans (setoid.symm hfg) hf,
  by simp [norm, hf, hg]
else have hg : ¬ g ≈ 0, from hf ∘ setoid.trans hfg,
by unfold norm; split_ifs; exact norm_eq_of_equiv hf hg hfg

private lemma norm_nonarchimedean_aux {f g : padic_seq p}
  (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : (f + g).norm ≤ max (f.norm) (g.norm) :=
begin
  unfold norm, split_ifs,
  padic_index_simp [hfg, hf, hg],
  apply padic_norm.nonarchimedean
end

theorem norm_nonarchimedean (f g : padic_seq p) : (f + g).norm ≤ max (f.norm) (g.norm) :=
if hfg : f + g ≈ 0 then
  have 0 ≤ max (f.norm) (g.norm), from le_max_left_of_le (norm_nonneg _),
  by simpa [hfg, norm]
else if hf : f ≈ 0 then
  have hfg' : f + g ≈ g,
  { change lim_zero (f - 0) at hf,
    show lim_zero (f + g - g), by simpa using hf },
  have hcfg : (f + g).norm = g.norm, from norm_equiv hfg',
  have hcl : f.norm = 0, from (norm_zero_iff f).2 hf,
  have max (f.norm) (g.norm) = g.norm,
    by rw hcl; exact max_eq_right (norm_nonneg _),
  by rw [this, hcfg]
else if hg : g ≈ 0 then
  have hfg' : f + g ≈ f,
  { change lim_zero (g - 0) at hg,
    show lim_zero (f + g - f), by  simpa [add_sub_cancel'] using hg },
  have hcfg : (f + g).norm = f.norm, from norm_equiv hfg',
  have hcl : g.norm = 0, from (norm_zero_iff g).2 hg,
  have max (f.norm) (g.norm) = f.norm,
    by rw hcl; exact max_eq_left (norm_nonneg _),
  by rw [this, hcfg]
else norm_nonarchimedean_aux hfg hf hg

lemma norm_eq {f g : padic_seq p} (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) :
  f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from equiv_zero_of_val_eq_of_equiv_zero h hf,
  by simp [hf, hg, norm]
else
  have hg : ¬ g ≈ 0, from λ hg, hf $ equiv_zero_of_val_eq_of_equiv_zero (by simp [h]) hg,
  begin
    simp [hg, hf, norm],
    let i := max (stationary_point hf) (stationary_point hg),
    have hpf : padic_norm p (f (stationary_point hf)) = padic_norm p (f i),
    { apply stationary_point_spec, apply le_max_left, apply le_refl },
    have hpg : padic_norm p (g (stationary_point hg)) = padic_norm p (g i),
    { apply stationary_point_spec, apply le_max_right, apply le_refl },
    rw [hpf, hpg, h]
  end

lemma norm_neg (a : padic_seq p) : (-a).norm = a.norm :=
norm_eq $ by simp

lemma norm_eq_of_add_equiv_zero {f g : padic_seq p} (h : f + g ≈ 0) : f.norm = g.norm :=
have lim_zero (f + g - 0), from h,
have f ≈ -g, from show lim_zero (f - (-g)), by simpa,
have f.norm = (-g).norm, from norm_equiv this,
by simpa [norm_neg] using this

lemma add_eq_max_of_ne {f g : padic_seq p} (hfgne : f.norm ≠ g.norm) :
  (f + g).norm = max f.norm g.norm :=
have hfg : ¬f + g ≈ 0, from mt norm_eq_of_add_equiv_zero hfgne,
if hf : f ≈ 0 then
  have lim_zero (f - 0), from hf,
  have f + g ≈ g, from show lim_zero ((f + g) - g), by simpa,
  have h1 : (f+g).norm = g.norm, from norm_equiv this,
  have h2 : f.norm = 0, from (norm_zero_iff _).2 hf,
  by rw [h1, h2]; rw max_eq_right (norm_nonneg _)
else if hg : g ≈ 0 then
  have lim_zero (g - 0), from hg,
  have f + g ≈ f, from show lim_zero ((f + g) - f), by rw [add_sub_cancel']; simpa,
  have h1 : (f+g).norm = f.norm, from norm_equiv this,
  have h2 : g.norm = 0, from (norm_zero_iff _).2 hg,
  by rw [h1, h2]; rw max_eq_left (norm_nonneg _)
else
begin
  unfold norm at ⊢ hfgne, split_ifs at ⊢ hfgne,
  padic_index_simp [hfg, hf, hg] at ⊢ hfgne,
  apply padic_norm.add_eq_max_of_ne,
  simpa [hf, hg, norm] using hfgne
end

end embedding
end padic_seq

def padic (p : ℕ) [nat.prime p] := @cau_seq.completion.Cauchy _ _ _ _ (padic_norm p) _
notation `ℚ_[` p `]` := padic p

namespace padic

section completion
variables {p : ℕ} [nat.prime p]

instance discrete_field : discrete_field (ℚ_[p]) :=
cau_seq.completion.discrete_field

-- short circuits

instance : has_zero ℚ_[p] := by apply_instance
instance : has_one ℚ_[p] := by apply_instance
instance : has_add ℚ_[p] := by apply_instance
instance : has_mul ℚ_[p] := by apply_instance
instance : has_sub ℚ_[p] := by apply_instance
instance : has_neg ℚ_[p] := by apply_instance
instance : has_div ℚ_[p] := by apply_instance
instance : add_comm_group ℚ_[p] := by apply_instance
instance : comm_ring ℚ_[p] := by apply_instance

def mk : padic_seq p → ℚ_[p] := quotient.mk
end completion

section completion
variables (p : ℕ) [nat.prime p]

lemma mk_eq {f g : padic_seq p} : mk f = mk g ↔ f ≈ g := quotient.eq

def of_rat : ℚ → ℚ_[p] := cau_seq.completion.of_rat

@[simp] lemma of_rat_add : ∀ (x y : ℚ), of_rat p (x + y) = of_rat p x + of_rat p y :=
cau_seq.completion.of_rat_add

@[simp] lemma of_rat_neg : ∀ (x : ℚ), of_rat p (-x) = -of_rat p x :=
cau_seq.completion.of_rat_neg

@[simp] lemma of_rat_mul : ∀ (x y : ℚ), of_rat p (x * y) = of_rat p x * of_rat p y :=
cau_seq.completion.of_rat_mul

@[simp] lemma of_rat_sub : ∀ (x y : ℚ), of_rat p (x - y) = of_rat p x - of_rat p y :=
cau_seq.completion.of_rat_sub

@[simp] lemma of_rat_div : ∀ (x y : ℚ), of_rat p (x / y) = of_rat p x / of_rat p y :=
cau_seq.completion.of_rat_div

@[simp] lemma of_rat_one : of_rat p 1 = 1 := rfl

@[simp] lemma of_rat_zero : of_rat p 0 = 0 := rfl

@[simp] lemma cast_eq_of_rat_of_nat (n : ℕ) : (↑n : ℚ_[p]) = of_rat p n :=
begin
  induction n with n ih,
  { refl },
  { simpa using ih }
end

-- without short circuits, this needs an increase of class.instance_max_depth
@[simp] lemma cast_eq_of_rat_of_int (n : ℤ) : ↑n = of_rat p n :=
by induction n; simp

lemma cast_eq_of_rat : ∀ (q : ℚ), (↑q : ℚ_[p]) = of_rat p q
| ⟨n, d, h1, h2⟩ :=
  show ↑n / ↑d = _, from
    have (⟨n, d, h1, h2⟩ : ℚ) = rat.mk n d, from rat.num_denom _,
    by simp [this, rat.mk_eq_div, of_rat_div]

@[norm_cast] lemma coe_add : ∀ {x y : ℚ}, (↑(x + y) : ℚ_[p]) = ↑x + ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_neg : ∀ {x : ℚ}, (↑(-x) : ℚ_[p]) = -↑x := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_mul : ∀ {x y : ℚ}, (↑(x * y) : ℚ_[p]) = ↑x * ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_sub : ∀ {x y : ℚ}, (↑(x - y) : ℚ_[p]) = ↑x - ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_div : ∀ {x y : ℚ}, (↑(x / y) : ℚ_[p]) = ↑x / ↑y := by simp [cast_eq_of_rat]

@[simp_cast] lemma coe_one : (↑1 : ℚ_[p]) = 1 := rfl
@[simp_cast] lemma coe_zero : (↑1 : ℚ_[p]) = 1 := rfl

lemma const_equiv {q r : ℚ} : const (padic_norm p) q ≈ const (padic_norm p) r ↔ q = r :=
⟨ λ heq : lim_zero (const (padic_norm p) (q - r)),
    eq_of_sub_eq_zero $ const_lim_zero.1 heq,
  λ heq, by rw heq; apply setoid.refl _ ⟩

lemma of_rat_eq {q r : ℚ} : of_rat p q = of_rat p r ↔ q = r :=
⟨(const_equiv p).1 ∘ quotient.eq.1, λ h, by rw h⟩

@[norm_cast] lemma coe_inj {q r : ℚ} : (↑q : ℚ_[p]) = ↑r ↔ q = r := by simp [cast_eq_of_rat, of_rat_eq]

instance : char_zero ℚ_[p] :=
have ∀ n : ℕ, (↑(↑n : ℚ) : ℚ_[p]) = ↑n, by simp,
⟨λ m n, by {rw_mod_cast ← this, refl}⟩

end completion
end padic

def padic_norm_e {p : ℕ} [hp : nat.prime p] : ℚ_[p] → ℚ :=
quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _

namespace padic_norm_e
section embedding
open padic_seq
variables {p : ℕ} [nat.prime p]

lemma defn (f : padic_seq p) {ε : ℚ} (hε : ε > 0) : ∃ N, ∀ i ≥ N, padic_norm_e (⟦f⟧ - f i) < ε :=
begin
  simp only [padic.cast_eq_of_rat],
  change ∃ N, ∀ i ≥ N, (f - const _ (f i)).norm < ε,
  by_contradiction h,
  cases cauchy₂ f hε with N hN,
  have : ∀ N, ∃ i ≥ N, (f - const _ (f i)).norm ≥ ε,
    by simpa [not_forall] using h,
  rcases this N with ⟨i, hi, hge⟩,
  have hne : ¬ (f - const (padic_norm p) (f i)) ≈ 0,
  { intro h, unfold padic_seq.norm at hge; split_ifs at hge, exact not_lt_of_ge hge hε },
  unfold padic_seq.norm at hge; split_ifs at hge,
  apply not_le_of_gt _ hge,
  cases decidable.em ((stationary_point hne) ≥ N) with hgen hngen,
  { apply hN; assumption },
  { have := stationary_point_spec hne (le_refl _) (le_of_not_le hngen),
    rw ←this,
    apply hN,
    apply le_refl, assumption }
end

protected lemma nonneg (q : ℚ_[p]) : padic_norm_e q ≥ 0 :=
quotient.induction_on q $ norm_nonneg

lemma zero_def : (0 : ℚ_[p]) = ⟦0⟧ := rfl

lemma zero_iff (q : ℚ_[p]) : padic_norm_e q = 0 ↔ q = 0 :=
quotient.induction_on q $
  by simpa only [zero_def, quotient.eq] using norm_zero_iff

@[simp] protected lemma zero : padic_norm_e (0 : ℚ_[p]) = 0 :=
(zero_iff _).2 rfl

@[simp] protected lemma one' : padic_norm_e (1 : ℚ_[p]) = 1 :=
norm_one

@[simp] protected lemma neg (q : ℚ_[p]) : padic_norm_e (-q) = padic_norm_e q :=
quotient.induction_on q $ norm_neg

theorem nonarchimedean' (q r : ℚ_[p]) :
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_nonarchimedean

theorem add_eq_max_of_ne' {q r : ℚ_[p]} :
  padic_norm_e q ≠ padic_norm_e r → padic_norm_e (q + r) = max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ λ _ _, padic_seq.add_eq_max_of_ne

lemma triangle_ineq (x y z : ℚ_[p]) :
  padic_norm_e (x - z) ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :=
calc padic_norm_e (x - z) = padic_norm_e ((x - y) + (y - z)) : by rw sub_add_sub_cancel
  ... ≤ max (padic_norm_e (x - y)) (padic_norm_e (y - z)) : padic_norm_e.nonarchimedean' _ _
  ... ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :
    max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma add (q r : ℚ_[p]) : padic_norm_e (q + r) ≤ (padic_norm_e q) + (padic_norm_e r) :=
calc
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) : nonarchimedean' _ _
                      ... ≤ (padic_norm_e q) + (padic_norm_e r) :
                              max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma mul' (q r : ℚ_[p]) : padic_norm_e (q * r) = (padic_norm_e q) * (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_mul

instance : is_absolute_value (@padic_norm_e p _) :=
{ abv_nonneg := padic_norm_e.nonneg,
  abv_eq_zero := zero_iff,
  abv_add := padic_norm_e.add,
  abv_mul := padic_norm_e.mul' }

@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (padic.of_rat p q) = padic_norm p q :=
norm_const _

protected theorem image' {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, padic_norm_e q = p ^ (-n) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (ne_zero_iff_nequiv_zero f).1 hf,
  norm_image f this

lemma sub_rev (q r : ℚ_[p]) : padic_norm_e (q - r) = padic_norm_e (r - q) :=
by rw ←(padic_norm_e.neg); simp

end embedding
end padic_norm_e

namespace padic

section complete
open padic_seq padic

theorem rat_dense' {p : ℕ} [nat.prime p] (q : ℚ_[p]) {ε : ℚ} (hε : ε > 0) :
  ∃ r : ℚ, padic_norm_e (q - r) < ε :=
quotient.induction_on q $ λ q',
  have ∃ N, ∀ m n ≥ N, padic_norm p (q' m - q' n) < ε, from cauchy₂ _ hε,
  let ⟨N, hN⟩ := this in
  ⟨q' N,
    begin
      simp only [padic.cast_eq_of_rat],
      change padic_seq.norm (q' - const _ (q' N)) < ε,
      cases decidable.em ((q' - const (padic_norm p) (q' N)) ≈ 0) with heq hne',
      { simpa only [heq, padic_seq.norm, dif_pos] },
      { simp only [padic_seq.norm, dif_neg hne'],
        change padic_norm p (q' _ - q' _) < ε,
        have := stationary_point_spec hne',
        cases decidable.em (N ≥ stationary_point hne') with hle hle,
        { have := eq.symm (this (le_refl _) hle),
          simp at this, simpa [this] },
        { apply hN,
          apply le_of_lt, apply lt_of_not_ge, apply hle, apply le_refl }}
    end⟩

variables {p : ℕ} [nat.prime p] (f : cau_seq _ (@padic_norm_e p _))
open classical

private lemma div_nat_pos (n : ℕ) : (1 / ((n + 1): ℚ)) > 0 :=
div_pos zero_lt_one (by exact_mod_cast succ_pos _)

def lim_seq : ℕ → ℚ := λ n, classical.some (rat_dense' (f n) (div_nat_pos n))

lemma exi_rat_seq_conv {ε : ℚ} (hε : 0 < ε) :
  ∃ N, ∀ i ≥ N, padic_norm_e (f i - ((lim_seq f) i : ℚ_[p])) < ε :=
begin
  refine (exists_nat_gt (1/ε)).imp (λ N hN i hi, _),
  have h := classical.some_spec (rat_dense' (f i) (div_nat_pos i)),
  refine lt_of_lt_of_le h (div_le_of_le_mul (by exact_mod_cast succ_pos _) _),
  rw right_distrib,
  apply le_add_of_le_of_nonneg,
  { exact le_mul_of_div_le hε (le_trans (le_of_lt hN) (by exact_mod_cast hi)) },
  { apply le_of_lt, simpa }
end

lemma exi_rat_seq_conv_cauchy : is_cau_seq (padic_norm p) (lim_seq f) :=
assume ε hε,
have hε3 : ε / 3 > 0, from div_pos hε (by norm_num),
let ⟨N, hN⟩ := exi_rat_seq_conv f hε3,
    ⟨N2, hN2⟩ := f.cauchy₂ hε3 in
begin
  existsi max N N2,
  intros j hj,
  suffices : padic_norm_e ((↑(lim_seq f j) - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
  { ring at this ⊢,
    rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat],
    exact_mod_cast this },
  { apply lt_of_le_of_lt,
    { apply padic_norm_e.add },
    { have : (3 : ℚ) ≠ 0, by norm_num,
      have : ε = ε / 3 + ε / 3 + ε / 3,
      { apply eq_of_mul_eq_mul_left this, simp [left_distrib, mul_div_cancel' _ this ], ring },
      rw this,
      apply add_lt_add,
      { suffices : padic_norm_e ((↑(lim_seq f j) - f j) + (f j - f (max N N2))) < ε / 3 + ε / 3,
          by simpa,
        apply lt_of_le_of_lt,
        { apply padic_norm_e.add },
        { apply add_lt_add,
          { rw [padic_norm_e.sub_rev],
            apply_mod_cast hN,
            exact le_of_max_le_left hj },
          { apply hN2,
            exact le_of_max_le_right hj,
            apply le_max_right }}},
      { apply_mod_cast hN,
        apply le_max_left }}}
end

private def lim' : padic_seq p := ⟨_, exi_rat_seq_conv_cauchy f⟩

private def lim : ℚ_[p] := ⟦lim' f⟧

theorem complete' : ∃ q : ℚ_[p], ∀ ε > 0, ∃ N, ∀ i ≥ N, padic_norm_e (q - f i) < ε :=
⟨ lim f,
  λ ε hε,
  let ⟨N, hN⟩ := exi_rat_seq_conv f (show ε / 2 > 0, from div_pos hε (by norm_num)),
      ⟨N2, hN2⟩ := padic_norm_e.defn (lim' f) (show ε / 2 > 0, from div_pos hε (by norm_num)) in
  begin
    existsi max N N2,
    intros i hi,
    suffices : padic_norm_e ((lim f - lim' f i) + (lim' f i - f i)) < ε,
    { ring at this; exact this },
    { apply lt_of_le_of_lt,
      { apply padic_norm_e.add },
      { have : ε = ε / 2 + ε / 2, by rw ←(add_self_div_two ε); simp,
        rw this,
        apply add_lt_add,
        { apply hN2, exact le_of_max_le_right hi },
        { rw_mod_cast [padic_norm_e.sub_rev],
          apply hN,
          exact le_of_max_le_left hi }}}
  end ⟩

end complete

section normed_space
variables (p : ℕ) [nat.prime p]

instance : has_dist ℚ_[p] := ⟨λ x y, padic_norm_e (x - y)⟩

instance : metric_space ℚ_[p] :=
{ dist_self := by simp [dist],
  dist_comm := λ x y, by unfold dist; rw ←padic_norm_e.neg (x - y); simp,
  dist_triangle :=
    begin
      intros, unfold dist,
      exact_mod_cast padic_norm_e.triangle_ineq _ _ _,
    end,
  eq_of_dist_eq_zero :=
    begin
      unfold dist, intros _ _ h,
      apply eq_of_sub_eq_zero,
      apply (padic_norm_e.zero_iff _).1,
      exact_mod_cast h
    end }

instance : has_norm ℚ_[p] := ⟨λ x, padic_norm_e x⟩

instance : normed_field ℚ_[p] :=
{ dist_eq := λ _ _, rfl,
  norm_mul := by simp [has_norm.norm, padic_norm_e.mul'] }

instance : is_absolute_value (λ a : ℚ_[p], ∥a∥) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := norm_eq_zero,
  abv_add := norm_triangle,
  abv_mul := by simp [has_norm.norm, padic_norm_e.mul'] }

theorem rat_dense {p : ℕ} {hp : p.prime} (q : ℚ_[p]) {ε : ℝ} (hε : ε > 0) :
        ∃ r : ℚ, ∥q - r∥ < ε :=
let ⟨ε', hε'l, hε'r⟩ := exists_rat_btwn hε,
    ⟨r, hr⟩ := rat_dense' q (by simpa using hε'l)  in
⟨r, lt.trans (by simpa [has_norm.norm] using hr) hε'r⟩

end normed_space
end padic

namespace padic_norm_e
section normed_space
variables {p : ℕ} [hp : p.prime]
include hp

@[simp] protected lemma mul (q r : ℚ_[p]) : ∥q * r∥ = ∥q∥ * ∥r∥ :=
by simp [has_norm.norm, padic_norm_e.mul']

protected lemma is_norm (q : ℚ_[p]) : ↑(padic_norm_e q) = ∥q∥ := rfl

theorem nonarchimedean (q r : ℚ_[p]) : ∥q + r∥ ≤ max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm,
  exact_mod_cast nonarchimedean' _ _
end

theorem add_eq_max_of_ne {q r : ℚ_[p]} (h : ∥q∥ ≠ ∥r∥) : ∥q+r∥ = max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm,
  apply_mod_cast add_eq_max_of_ne',
  intro h',
  apply h,
  unfold has_norm.norm,
  exact_mod_cast h'
end

@[simp] lemma eq_padic_norm (q : ℚ) : ∥(↑q : ℚ_[p])∥ = padic_norm p q :=
begin
  unfold has_norm.norm,
  rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat]
end

instance : nondiscrete_normed_field ℚ_[p] :=
{ non_trivial := ⟨padic.of_rat p (p⁻¹), begin
    have h0 : p ≠ 0 := ne_of_gt (hp.pos),
    have h1 : 1 < p := prime.gt_one hp,
    rw [← padic.cast_eq_of_rat, eq_padic_norm],
    simp only [padic_norm, inv_eq_zero],
    rw if_neg,
    swap, exact_mod_cast h0,
    norm_cast,
    rw padic_val_rat.inv,
    swap, exact_mod_cast h0,
    rw [neg_neg, padic_val_rat.padic_val_rat_self h1],
    erw _root_.pow_one,
    exact_mod_cast h1,
  end⟩ }

protected theorem image {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, ∥q∥ = ↑((↑p : ℚ) ^ (-n)) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (padic_seq.ne_zero_iff_nequiv_zero f).1 hf,
  let ⟨n, hn⟩ := padic_seq.norm_image f this in
  ⟨n, congr_arg rat.cast hn⟩

protected lemma is_rat (q : ℚ_[p]) : ∃ q' : ℚ, ∥q∥ = ↑q' :=
if h : q = 0 then ⟨0, by simp [h]⟩
else let ⟨n, hn⟩ := padic_norm_e.image h in ⟨_, hn⟩

def rat_norm (q : ℚ_[p]) : ℚ := classical.some (padic_norm_e.is_rat q)

lemma eq_rat_norm (q : ℚ_[p]) : ∥q∥ = rat_norm q := classical.some_spec (padic_norm_e.is_rat q)

theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ∥(q : ℚ_[p])∥ ≤ 1
| ⟨n, d, hn, hd⟩ := λ hq : ¬ p ∣ d,
  if hnz : n = 0 then
    have (⟨n, d, hn, hd⟩ : ℚ) = 0,
    from rat.zero_iff_num_zero.mpr hnz,
    by norm_num [this]
  else
    begin
      have hnz' : {rat . num := n, denom := d, pos := hn, cop := hd} ≠ 0, from mt rat.zero_iff_num_zero.1 hnz,
      rw [padic_norm_e.eq_padic_norm],
      norm_cast,
      rw [padic_norm.eq_fpow_of_nonzero p hnz', padic_val_rat_def p hnz'],
      have h : (multiplicity p d).get _ = 0, by simp [multiplicity_eq_zero_of_not_dvd, hq],
      rw_mod_cast [h, sub_zero],
      apply fpow_le_one_of_nonpos,
      { exact_mod_cast le_of_lt hp.gt_one, },
      { apply neg_nonpos_of_nonneg, norm_cast, simp, }
    end

lemma eq_of_norm_add_lt_right {p : ℕ} {hp : p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_right) h

lemma eq_of_norm_add_lt_left {p : ℕ} {hp : p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_left) h

end normed_space
end padic_norm_e

namespace padic
variables {p : ℕ} [nat.prime p]

set_option eqn_compiler.zeta true
instance complete : cau_seq.is_complete ℚ_[p] norm :=
begin
  split, intro f,
  have cau_seq_norm_e : is_cau_seq padic_norm_e f, by {
    intros ε hε,
    let h := is_cau f ε (by exact_mod_cast hε),
    unfold norm at h,
    apply_mod_cast h,
  },
  cases padic.complete' ⟨f, cau_seq_norm_e⟩ with q hq,
  existsi q,
  intros ε hε,
  cases exists_rat_btwn hε with ε' hε',
  norm_cast at hε',
  cases hq ε' hε'.1 with N hN, existsi N,
  intros i hi, let h := hN i hi,
  unfold norm,
  rw_mod_cast [cau_seq.sub_apply, padic_norm_e.sub_rev],
  refine lt.trans _ hε'.2,
  exact_mod_cast hN i hi
end

lemma padic_norm_e_lim_le {f : cau_seq ℚ_[p] norm} {a : ℝ} (ha : a > 0)
      (hf : ∀ i, ∥f i∥ ≤ a) : ∥f.lim∥ ≤ a :=
let ⟨N, hN⟩ := setoid.symm (cau_seq.equiv_lim f) _ ha in
calc ∥f.lim∥ = ∥f.lim - f N + f N∥ : by simp
                ... ≤ max (∥f.lim - f N∥) (∥f N∥) : padic_norm_e.nonarchimedean _ _
                ... ≤ a : max_le (le_of_lt (hN _ (le_refl _))) (hf _)

end padic


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.eval
import Mathlib.tactic.interval_cases
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Theory of degrees of polynomials

Some of the main results include
- `nat_degree_comp_le` : The degree of the composition is at most the product of degrees

-/

namespace polynomial

theorem nat_degree_comp_le {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    nat_degree (comp p q) ≤ nat_degree p * nat_degree q :=
  sorry

theorem degree_map_le {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) : degree (map f p) ≤ degree p :=
  sorry

theorem nat_degree_map_le {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) : nat_degree (map f p) ≤ nat_degree p :=
  sorry

theorem degree_map_eq_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R]
    {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) :
    degree (map f p) = degree p :=
  sorry

theorem nat_degree_map_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R]
    {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) :
    nat_degree (map f p) = nat_degree p :=
  nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero f hf)

theorem leading_coeff_map_of_leading_coeff_ne_zero {R : Type u} {S : Type v} [semiring R]
    {p : polynomial R} [semiring S] (f : R →+* S) (hf : coe_fn f (leading_coeff p) ≠ 0) :
    leading_coeff (map f p) = coe_fn f (leading_coeff p) :=
  sorry

theorem degree_pos_of_root {R : Type u} {a : R} [semiring R] {p : polynomial R} (hp : p ≠ 0)
    (h : is_root p a) : 0 < degree p :=
  sorry

theorem nat_degree_pos_of_eval₂_root {R : Type u} {S : Type v} [semiring R] [semiring S]
    {p : polynomial R} (hp : p ≠ 0) (f : R →+* S) {z : S} (hz : eval₂ f z p = 0)
    (inj : ∀ (x : R), coe_fn f x = 0 → x = 0) : 0 < nat_degree p :=
  sorry

theorem degree_pos_of_eval₂_root {R : Type u} {S : Type v} [semiring R] [semiring S]
    {p : polynomial R} (hp : p ≠ 0) (f : R →+* S) {z : S} (hz : eval₂ f z p = 0)
    (inj : ∀ (x : R), coe_fn f x = 0 → x = 0) : 0 < degree p :=
  iff.mp nat_degree_pos_iff_degree_pos (nat_degree_pos_of_eval₂_root hp f hz inj)

theorem degree_map_eq_of_injective {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S}
    (hf : function.injective ⇑f) (p : polynomial R) : degree (map f p) = degree p :=
  sorry

theorem degree_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S}
    (hf : function.injective ⇑f) (p : polynomial R) : degree (map f p) = degree p :=
  degree_map_eq_of_injective hf p

theorem nat_degree_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S}
    (hf : function.injective ⇑f) (p : polynomial R) : nat_degree (map f p) = nat_degree p :=
  nat_degree_eq_of_degree_eq (degree_map' hf p)

theorem leading_coeff_map' {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S}
    (hf : function.injective ⇑f) (p : polynomial R) :
    leading_coeff (map f p) = coe_fn f (leading_coeff p) :=
  sorry

theorem monomial_nat_degree_leading_coeff_eq_self {R : Type u} [semiring R] {f : polynomial R}
    (h : finset.card (finsupp.support f) ≤ 1) :
    coe_fn (monomial (nat_degree f)) (leading_coeff f) = f :=
  sorry

theorem C_mul_X_pow_eq_self {R : Type u} [semiring R] {f : polynomial R}
    (h : finset.card (finsupp.support f) ≤ 1) : coe_fn C (leading_coeff f) * X ^ nat_degree f = f :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.mean_value
import Mathlib.PostPort

namespace Mathlib

/-!
# Darboux's theorem

In this file we prove that the derivative of a differentiable function on an interval takes all
intermediate values. The proof is based on the
[Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem.
-/

/-- Darboux's theorem: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_gt_of_lt {a : ℝ} {b : ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ}
    (hab : a ≤ b) (hf : ∀ (x : ℝ), x ∈ set.Icc a b → has_deriv_within_at f (f' x) (set.Icc a b) x)
    {m : ℝ} (hma : f' a < m) (hmb : m < f' b) : m ∈ f' '' set.Icc a b :=
  sorry

/-- Darboux's theorem: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`. -/
theorem exists_has_deriv_within_at_eq_of_lt_of_gt {a : ℝ} {b : ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ}
    (hab : a ≤ b) (hf : ∀ (x : ℝ), x ∈ set.Icc a b → has_deriv_within_at f (f' x) (set.Icc a b) x)
    {m : ℝ} (hma : m < f' a) (hmb : f' b < m) : m ∈ f' '' set.Icc a b :=
  sorry

/-- Darboux's theorem: the image of a convex set under `f'` is a convex set. -/
theorem convex_image_has_deriv_at {f : ℝ → ℝ} {f' : ℝ → ℝ} {s : set ℝ} (hs : convex s)
    (hf : ∀ (x : ℝ), x ∈ s → has_deriv_at f (f' x) x) : convex (f' '' s) :=
  sorry

/-- If the derivative of a function is never equal to `m`, then either
it is always greater than `m`, or it is always less than `m`. -/
theorem deriv_forall_lt_or_forall_gt_of_forall_ne {f : ℝ → ℝ} {f' : ℝ → ℝ} {s : set ℝ}
    (hs : convex s) (hf : ∀ (x : ℝ), x ∈ s → has_deriv_at f (f' x) x) {m : ℝ}
    (hf' : ∀ (x : ℝ), x ∈ s → f' x ≠ m) :
    (∀ (x : ℝ), x ∈ s → f' x < m) ∨ ∀ (x : ℝ), x ∈ s → m < f' x :=
  sorry

end Mathlib