/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import algebraic_geometry.prime_spectrum.basic
import ring_theory.dedekind_domain.ideal
import topology.algebra.valued_field

/-!
# Adic valuations on Dedekind domains
Given a Dedekind domain `R` of Krull dimension 1 and a maximal ideal `v` of `R`, we define the
`v`-adic valuation on `R` and its extension to the field of fractions `K` of `R`.
We prove several properties of this valuation, including the existence of uniformizers.

## Main definitions
 - `maximal_spectrum` defines the set of nonzero prime ideals of `R`. When `R` is a Dedekind domain
   of Krull dimension 1, this is the set of maximal ideals of `R`.
 - `maximal_spectrum.int_valuation v` is the `v`-adic valuation on `R`.
 - `maximal_spectrum.valuation v` is the `v`-adic valuation on `K`.

## Main results
- `int_valuation_le_one` : The `v`-adic valuation on `R` is bounded above by 1.
- `int_valuation_lt_one_iff_dvd` : The `v`-adic valuation of `r ∈ R` is less than 1 if and only if
  `v` divides the ideal `(r)`.
- `int_valuation_le_pow_iff_dvd` : The `v`-adic valuation of `r ∈ R` is less than or equal to
  `multiplicative.of_add (-n)` if and only if `vⁿ` divides the ideal `(r)`.
- `int_valuation_exists_uniformizer` : There exists `π ∈ R` with `v`-adic valuation
  `multiplicative.of_add (-1)`.
- `valuation_well_defined` : The valuation of `k ∈ K` is independent on how we express `k`
  as a fraction.
- `valuation_of_mk'` : The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by
  the valuation of `s`.
- `valuation_of_algebra_map` : The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`.
- `valuation_exists_uniformizer` : There exists `π ∈ K` with `v`-adic valuation
  `multiplicative.of_add (-1)`.

## Implementation notes
We are only interested in Dedekind domains with Krull dimension 1. Dedekind domains of Krull
dimension 0 are fields, and for them `maximal_spectrum` is the empty set, which does not agree with
the set of maximal ideals (which is {(0)}).

Most of the code in this file has already been incorporated to mathlib and can be found in the files
`ring_theory/dedekind_domain/ideal.lean` and `ring_theory/dedekind_domain/adic_valuation.lean`. Note
that `maximal_spectrum` is called `height_one_spectrum` there, and that some of the names of
definitions and lemmas have been modified. We keep this version of the code here so that this branch
contains all of the code referred to in the article "Formalizing the Rings of Adèles of a Global
Field".

## References
* [G. J. Janusz, *Algebraic Number Fields*][janusz1996]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags
dedekind domain, dedekind ring, adic valuation
-/

noncomputable theory
open_locale classical

variables (R : Type*) [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type*} [field K]
  [algebra R K] [is_fraction_ring R K]

/-!
### Maximal spectrum of a Dedekind domain
If `R` is a Dedekind domain of Krull dimension 1, the maximal ideals of `R` are exactly its nonzero
prime ideals.

We define `maximal_spectrum` and provide lemmas to recover the facts that maximal ideals are prime
and irreducible. -/

/-- The maximal spectrum of a Dedekind domain `R` of Krull dimension 1 is its set of nonzero prime
ideals. Note that this is not the maximal spectrum if `R` has Krull dimension 0. -/
@[ext, nolint has_inhabited_instance unused_arguments]
structure maximal_spectrum :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)
(ne_bot   : as_ideal ≠ ⊥)

variables (v : maximal_spectrum R) {R}

--Maximal spectrum lemmas
lemma maximal_spectrum.prime (v : maximal_spectrum R) : prime v.as_ideal :=
ideal.prime_of_is_prime v.ne_bot v.is_prime

lemma maximal_spectrum.irreducible (v : maximal_spectrum R) :
  irreducible v.as_ideal :=
begin
  rw [unique_factorization_monoid.irreducible_iff_prime],
  apply v.prime,
end

lemma maximal_spectrum.associates_irreducible (v : maximal_spectrum R) :
  irreducible (associates.mk v.as_ideal) :=
begin
  rw [associates.irreducible_mk _],
  apply v.irreducible,
end

/-!
### Auxiliary lemmas
We provide auxiliary lemmas about `multiplicative.of_add`, `is_localization`, `associates` and
`ideal`. They will be moved to the appropriate files when the code is integrated in `mathlib`. -/

-- of_add lemmas
lemma of_add_le (α : Type*) [partial_order α] (x y : α) :
  multiplicative.of_add x ≤ multiplicative.of_add y ↔ x ≤ y := by refl

lemma of_add_lt (α : Type*) [partial_order α] (x y : α) :
  multiplicative.of_add x < multiplicative.of_add y ↔ x < y := by refl

lemma of_add_inj (α : Type*) (x y : α)
  (hxy : multiplicative.of_add x = multiplicative.of_add y) : x = y :=
by rw [← to_add_of_add x, ← to_add_of_add y, hxy]

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

lemma is_localization.mk'_eq_zero {r : A} {s : non_zero_divisors A}
  (h : is_localization.mk' S r s = 0) : r = 0 :=
begin
  rw [is_fraction_ring.mk'_eq_div, div_eq_zero_iff] at h,
  apply is_fraction_ring.injective A S,
  rw (algebra_map A S).map_zero,
  exact or.resolve_right h (is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors s.property)
end

variable (S)
lemma is_localization.mk'_eq_one {r : A} {s : non_zero_divisors A}
  (h : is_localization.mk' S r s = 1) : r = s :=
begin
  rw [is_fraction_ring.mk'_eq_div, div_eq_one_iff_eq] at h,
  { exact is_fraction_ring.injective A S h },
  { exact is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors s.property }
end

-- Ideal lemmas
lemma ideal.mem_pow_count {x : R} (hx : x ≠ 0) {I : ideal R} (hI : irreducible I) :
  x ∈ I^((associates.mk I).count (associates.mk (ideal.span {x})).factors) :=
begin
  have hx' := associates.mk_ne_zero'.mpr hx,
  rw [← associates.le_singleton_iff,
    associates.prime_pow_dvd_iff_le hx' ((associates.irreducible_mk I).mpr hI)],
end

namespace maximal_spectrum
/-! ### Adic valuations on the Dedekind domain R -/

/-- The additive `v`-adic valuation of `r ∈ R` is the exponent of `v` in the factorization of the
ideal `(r)`, if `r` is nonzero, or infinity, if `r = 0`. `int_valuation_def` is the corresponding
multiplicative valuation. -/
def int_valuation_def (r : R) : with_zero (multiplicative ℤ) :=
if r = 0 then 0 else multiplicative.of_add
  (-(associates.mk v.as_ideal).count (associates.mk (ideal.span {r} : ideal R)).factors : ℤ)

lemma int_valuation_def_if_pos {r : R} (hr : r = 0) : v.int_valuation_def r = 0 := if_pos hr

lemma int_valuation_def_if_neg {r : R} (hr : r ≠ 0) : v.int_valuation_def r = (multiplicative.of_add
  (-(associates.mk v.as_ideal).count (associates.mk (ideal.span {r} : ideal R)).factors : ℤ)) :=
if_neg hr

/-- Nonzero elements have nonzero adic valuation. -/
lemma int_valuation_ne_zero (x : R) (hx : x ≠ 0) : v.int_valuation_def x ≠ 0 :=
begin
  rw [int_valuation_def, if_neg hx],
  exact with_zero.coe_ne_zero,
end

/-- Nonzero divisors have nonzero valuation. -/
lemma int_valuation_ne_zero' (x : non_zero_divisors R) : v.int_valuation_def x ≠ 0 :=
v.int_valuation_ne_zero x (non_zero_divisors.coe_ne_zero x)

/-- Nonzero divisors have valuation greater than zero. -/
lemma int_valuation_zero_le (x : non_zero_divisors R) : 0 < v.int_valuation_def x :=
begin
  rw [v.int_valuation_def_if_neg (non_zero_divisors.coe_ne_zero x)],
  exact with_zero.zero_lt_coe _,
end

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma int_valuation_le_one (x : R) : v.int_valuation_def x ≤ 1 :=
begin
  rw int_valuation_def,
  by_cases hx : x = 0,
  { rw if_pos hx, exact with_zero.zero_le 1 },
  { rw [if_neg hx, ← with_zero.coe_one, ← of_add_zero, with_zero.coe_le_coe, of_add_le,
      right.neg_nonpos_iff],
    exact int.coe_nat_nonneg _ }
end

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma int_valuation_lt_one_iff_dvd (r : R) :
  v.int_valuation_def r < 1 ↔ v.as_ideal ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simpa [hr] using (with_zero.zero_lt_coe _) },
  { rw [← with_zero.coe_one, ← of_add_zero, with_zero.coe_lt_coe, of_add_lt, neg_lt_zero,
      ← int.coe_nat_zero, int.coe_nat_lt, zero_lt_iff],
    have h : (ideal.span {r} : ideal R) ≠ 0,
    { rw [ne.def, ideal.zero_eq_bot, ideal.span_singleton_eq_bot],
      exact hr },
    apply associates.count_ne_zero_iff_dvd h (by apply v.irreducible) }
end

/-- The `v`-adic valuation of `r ∈ R` is less than `multiplicative.of_add (-n)` if and only if
`vⁿ` divides the ideal `(r)`. -/
lemma int_valuation_le_pow_iff_dvd (r : R) (n : ℕ) :
  v.int_valuation_def r ≤ multiplicative.of_add (-(n : ℤ)) ↔ v.as_ideal^n ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simp_rw [hr, ideal.dvd_span_singleton, zero_le', submodule.zero_mem], },
  { rw [with_zero.coe_le_coe, of_add_le, neg_le_neg_iff, int.coe_nat_le, ideal.dvd_span_singleton,
      ← associates.le_singleton_iff, associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hr)
      (by apply v.associates_irreducible)] }
end

/-- The `v`-adic valuation of `0 : R` equals 0. -/
lemma int_valuation.map_zero' : v.int_valuation_def 0 = 0 := v.int_valuation_def_if_pos (eq.refl 0)

/-- The `v`-adic valuation of `1 : R` equals 1. -/
lemma int_valuation.map_one' : v.int_valuation_def 1 = 1 :=
by rw [v.int_valuation_def_if_neg (zero_ne_one.symm : (1 : R) ≠ 0), ideal.span_singleton_one,
  ← ideal.one_eq_top, associates.mk_one, associates.factors_one, associates.count_zero
  (by apply v.associates_irreducible), int.coe_nat_zero, neg_zero, of_add_zero, with_zero.coe_one]

/-- The `v`-adic valuation of a product equals the product of the valuations. -/
lemma int_valuation.map_mul' (x y : R) :
  v.int_valuation_def (x * y) = v.int_valuation_def x * v.int_valuation_def y :=
begin
  simp only [int_valuation_def],
  by_cases hx : x = 0,
  { rw [hx, zero_mul, if_pos (eq.refl _), zero_mul] },
  { by_cases hy : y = 0,
    { rw [hy, mul_zero, if_pos (eq.refl _), mul_zero] },
    { rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy), ← with_zero.coe_mul, with_zero.coe_inj,
        ← of_add_add, ← ideal.span_singleton_mul_span_singleton, ← associates.mk_mul_mk, ← neg_add,
        associates.count_mul (by apply associates.mk_ne_zero'.mpr hx)
        (by apply associates.mk_ne_zero'.mpr hy) (by apply v.associates_irreducible)],
      refl }}
end

lemma int_valuation.le_max_iff_min_le {a b c : ℕ} :  multiplicative.of_add(-c : ℤ) ≤
  max (multiplicative.of_add(-a : ℤ)) (multiplicative.of_add(-b : ℤ)) ↔ min a b ≤ c :=
by rw [le_max_iff, of_add_le, of_add_le, neg_le_neg_iff, neg_le_neg_iff, int.coe_nat_le,
    int.coe_nat_le, ← min_le_iff]

/- @[simp] lemma with_zero.le_max_iff {M : Type} [linear_ordered_comm_monoid M] {a b c : M} :
  (a : with_zero M) ≤ max b c ↔ a ≤ max b c :=
by simp only [with_zero.coe_le_coe, le_max_iff] -/

/-- The `v`-adic valuation of a sum is bounded above by the maximum of the valuations. -/
lemma int_valuation.map_add_le_max' (x y : R) : v.int_valuation_def (x + y) ≤
  max (v.int_valuation_def x) (v.int_valuation_def y) :=
begin
  by_cases hx : x = 0,
  { rw [hx, zero_add],
    conv_rhs {rw [int_valuation_def, if_pos (eq.refl _)]},
    rw max_eq_right (with_zero.zero_le (v.int_valuation_def y)),
    exact le_refl _, },
  { by_cases hy : y = 0,
    { rw [hy, add_zero],
      conv_rhs {rw [max_comm, int_valuation_def, if_pos (eq.refl _)]},
      rw max_eq_right (with_zero.zero_le (v.int_valuation_def x)),
      exact le_refl _ },
    { by_cases hxy : x + y = 0,
      { rw [int_valuation_def, if_pos hxy], exact zero_le',},
      { rw [v.int_valuation_def_if_neg hxy, v.int_valuation_def_if_neg hx,
          v.int_valuation_def_if_neg hy, with_zero.le_max_iff, int_valuation.le_max_iff_min_le],
      set nmin := min
        ((associates.mk v.as_ideal).count (associates.mk (ideal.span {x})).factors)
        ((associates.mk v.as_ideal).count (associates.mk (ideal.span {y})).factors),
      have h_dvd_x : x ∈ v.as_ideal ^ (nmin),
      { rw [← associates.le_singleton_iff x nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hx) _],
        exact min_le_left _ _,
        apply v.associates_irreducible },
      have h_dvd_y : y ∈ v.as_ideal ^ nmin,
      { rw [← associates.le_singleton_iff y nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hy) _],
        exact min_le_right _ _,
        apply v.associates_irreducible },
      have h_dvd_xy : associates.mk v.as_ideal^nmin ≤ associates.mk (ideal.span {x + y}),
      { rw associates.le_singleton_iff,
        exact ideal.add_mem (v.as_ideal^nmin) h_dvd_x h_dvd_y, },
      rw (associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hxy) _) at h_dvd_xy,
      exact h_dvd_xy,
      apply v.associates_irreducible, }}}
end

/-- The `v`-adic valuation on `R`. -/
def int_valuation : valuation R (with_zero (multiplicative ℤ)) :=
{ to_fun           := v.int_valuation_def,
  map_zero'        := int_valuation.map_zero' v,
  map_one'         := int_valuation.map_one' v,
  map_mul'         := int_valuation.map_mul' v,
  map_add_le_max'  := int_valuation.map_add_le_max' v }

lemma int_valuation_apply (r : R) : v.int_valuation r = v.int_valuation_def r := rfl

/-- There exists `π ∈ R` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma int_valuation_exists_uniformizer :
  ∃ (π : R), v.int_valuation_def π = multiplicative.of_add (-1 : ℤ) :=
begin
  have hv : _root_.irreducible (associates.mk v.as_ideal) := v.associates_irreducible,
  have hlt : v.as_ideal^2 < v.as_ideal,
  { rw ← ideal.dvd_not_unit_iff_lt,
    exact ⟨v.ne_bot, v.as_ideal,
     (not_congr ideal.is_unit_iff).mpr (ideal.is_prime.ne_top v.is_prime), sq v.as_ideal⟩ } ,
  obtain ⟨π, mem, nmem⟩ := set_like.exists_of_lt hlt,
  have hπ : associates.mk (ideal.span {π}) ≠ 0,
  { rw associates.mk_ne_zero',
    intro h,
    rw h at nmem,
    exact nmem (submodule.zero_mem (v.as_ideal^2)), },
  use π,
  rw [int_valuation_def, if_neg (associates.mk_ne_zero'.mp hπ), with_zero.coe_inj],
  apply congr_arg,
  rw [neg_inj, ← int.coe_nat_one, int.coe_nat_inj'],
  rw [← ideal.dvd_span_singleton, ← associates.mk_le_mk_iff_dvd_iff] at mem nmem,
  rw [← pow_one ( associates.mk v.as_ideal),
    associates.prime_pow_dvd_iff_le hπ hv]  at mem,
  rw [associates.mk_pow, associates.prime_pow_dvd_iff_le hπ hv, not_le] at nmem,
  exact nat.eq_of_le_of_lt_succ mem nmem,
end

/-! ### Adic valuations on the field of fractions `K` -/
/-- The `v`-adic valuation of `x ∈ K` is the valuation of `r` divided by the valuation of `s`,
where `r` and `s` are chosen so that `x = r/s`. -/
def valuation_def (x : K) : (with_zero (multiplicative ℤ)) :=
let s := classical.some (classical.some_spec (is_localization.mk'_surjective
  (non_zero_divisors R) x)) in (v.int_valuation_def (classical.some
    (is_localization.mk'_surjective (non_zero_divisors R) x)))/(v.int_valuation_def s)

variable (K)
/-- The valuation of `k ∈ K` is independent on how we express `k` as a fraction. -/
lemma valuation_well_defined {r r' : R} {s s' : non_zero_divisors R}
  (h_mk : is_localization.mk' K r s = is_localization.mk' K r' s') :
  (v.int_valuation_def r)/(v.int_valuation_def s) =
  (v.int_valuation_def r')/(v.int_valuation_def s') :=
begin
  rw [div_eq_div_iff (int_valuation_ne_zero' v s) (int_valuation_ne_zero' v s'),
  ← int_valuation.map_mul', ← int_valuation.map_mul',
  is_fraction_ring.injective R K (is_localization.mk'_eq_iff_eq.mp h_mk)],
end

/-- The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by the valuation of `s`. -/
lemma valuation_of_mk' {r : R} {s : non_zero_divisors R} :
  v.valuation_def (is_localization.mk' K r s) =
   (v.int_valuation_def r)/(v.int_valuation_def s) :=
begin
  rw valuation_def,
  exact valuation_well_defined K v
    (classical.some_spec (classical.some_spec (is_localization.mk'_surjective (non_zero_divisors R)
    (is_localization.mk' K r s)))),
end

variable {K}
/-- The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`. -/
lemma valuation_of_algebra_map {r : R} :
  v.valuation_def (algebra_map R K r) = v.int_valuation_def r :=
by rw [← is_localization.mk'_one K r, valuation_of_mk', submonoid.coe_one,
    int_valuation.map_one', div_one _]

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma valuation_le_one (r : R) : v.valuation_def (algebra_map R K r) ≤ 1 :=
by { rw valuation_of_algebra_map, exact v.int_valuation_le_one r }

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma valuation_lt_one_iff_dvd (r : R) :
  v.valuation_def (algebra_map R K r) < 1 ↔ v.as_ideal ∣ ideal.span {r} :=
by { rw valuation_of_algebra_map, exact v.int_valuation_lt_one_iff_dvd r }

/-- The `v`-adic valuation of `0 : K` equals 0. -/
lemma valuation.map_zero' (v : maximal_spectrum R) :
  v.valuation_def (0 : K) = 0 :=
begin
  rw [← (algebra_map R K).map_zero, valuation_of_algebra_map v],
  exact v.int_valuation.map_zero',
end

/-- The `v`-adic valuation of `1 : K` equals 1. -/
lemma valuation.map_one' (v : maximal_spectrum R) :
  v.valuation_def (1 : K) = 1 :=
begin
  rw [← (algebra_map R K).map_one, valuation_of_algebra_map v],
  exact v.int_valuation.map_one',
end

/-- The `v`-adic valuation of a product is the product of the valuations. -/
lemma valuation.map_mul' (v : maximal_spectrum R) (x y : K) :
  v.valuation_def (x * y) = v.valuation_def x * v.valuation_def y :=
begin
  rw [valuation_def, valuation_def, valuation_def, div_mul_div_comm₀, ← int_valuation.map_mul',
  ← int_valuation.map_mul', ← submonoid.coe_mul],
  apply valuation_well_defined K v,
  rw [(classical.some_spec (valuation_def._proof_2 (x * y))), is_fraction_ring.mk'_eq_div,
    (algebra_map R K).map_mul, submonoid.coe_mul, (algebra_map R K).map_mul, ← div_mul_div_comm₀,
    ← is_fraction_ring.mk'_eq_div, ← is_fraction_ring.mk'_eq_div,
    (classical.some_spec (valuation_def._proof_2 x)),
    (classical.some_spec (valuation_def._proof_2 y))],
end

/-- The `v`-adic valuation of a sum is bounded above by the maximum of the valuations. -/
lemma valuation.map_add_le_max' (v : maximal_spectrum R) (x y : K) :
  v.valuation_def (x + y) ≤ max (v.valuation_def x) (v.valuation_def y) :=
begin
  obtain ⟨rx, sx, hx⟩ := is_localization.mk'_surjective (non_zero_divisors R) x,
  obtain ⟨rxy, sxy, hxy⟩ := is_localization.mk'_surjective (non_zero_divisors R) (x + y),
  obtain ⟨ry, sy, hy⟩ := is_localization.mk'_surjective (non_zero_divisors R) y,
  rw [← hxy, ← hx, ← hy, valuation_of_mk', valuation_of_mk', valuation_of_mk'],
  have h_frac_xy : is_localization.mk' K rxy sxy =
    is_localization.mk' K (rx*(sy : R) + ry*(sx : R)) (sx*sy),
  { rw [is_localization.mk'_add, hx, hy, hxy], },
  have h_frac_x : is_localization.mk' K rx sx = is_localization.mk' K (rx*(sy : R)) (sx*sy),
  { rw [is_localization.mk'_eq_iff_eq, submonoid.coe_mul, mul_assoc, mul_comm (sy : R) _], },
  have h_frac_y : is_localization.mk' K ry sy = is_localization.mk' K (ry*(sx : R)) (sx*sy),
  { rw [is_localization.mk'_eq_iff_eq, submonoid.coe_mul, mul_assoc], },
  have h_denom : 0 < v.int_valuation_def ↑(sx * sy),
  { rw [int_valuation_def, if_neg _],
    { exact with_zero.zero_lt_coe _ },
    { exact non_zero_divisors.ne_zero
        (submonoid.mul_mem (non_zero_divisors R) sx.property sy.property), }},
  rw [valuation_well_defined K v h_frac_x, valuation_well_defined K v h_frac_y,
    valuation_well_defined K v h_frac_xy, le_max_iff, div_le_div_right₀ (ne_of_gt h_denom),
    div_le_div_right₀ (ne_of_gt h_denom), ← le_max_iff],
  exact v.int_valuation.map_add_le_max' _ _,
end

/-- The `v`-adic valuation on `K`. -/
def valuation (v : maximal_spectrum R) : valuation K (with_zero (multiplicative ℤ)) := {
  to_fun    := v.valuation_def,
  map_zero' := valuation.map_zero' v,
  map_one'  := valuation.map_one' v,
  map_mul'  := valuation.map_mul' v,
  map_add_le_max'  := valuation.map_add_le_max' v }

lemma valuation_apply (k : K) : v.valuation k = v.valuation_def k := rfl

variable (K)
/-- There exists `π ∈ K` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma valuation_exists_uniformizer :
  ∃ (π : K), v.valuation_def π = multiplicative.of_add (-1 : ℤ) :=
begin
  obtain ⟨r, hr⟩ := v.int_valuation_exists_uniformizer,
  use algebra_map R K r,
  rw valuation_of_algebra_map v,
  exact hr,
end

/-- Uniformizers are nonzero. -/
lemma valuation_uniformizer_ne_zero :
  (classical.some (v.valuation_exists_uniformizer K)) ≠ 0 :=
begin
  have hu := (classical.some_spec (v.valuation_exists_uniformizer K)),
  have h : v.valuation_def (classical.some _) = valuation v (classical.some _) := rfl,
  rw h at hu,
  exact (valuation.ne_zero_iff _).mp (ne_of_eq_of_ne hu with_zero.coe_ne_zero),
end

end maximal_spectrum


import breen_deligne.constants

open_locale nnreal

namespace breen_deligne

namespace eg

/-!

# An explicit nontrivial example of Breen-Deligne data

This example is explained in Definition 1.10 of
the blueprint https://leanprover-community.github.io/liquid/ .

-/

open universal_map

/-- The `i`-th rank of this BD package is `2^i`. -/
def rank (i : ℕ) : FreeMat := 2 ^ i

/-- `σπ n` is an abreviation for `proj n 2 - sum n 2`. -/
def σπ (n : ℕ) := universal_map.proj n 2 - universal_map.sum n 2

lemma σπ_comp_mul_two {m n} (f : universal_map m n) :
  comp (σπ n) (mul 2 f) = comp f (σπ m) :=
by simp only [σπ, add_monoid_hom.map_sub, add_monoid_hom.sub_apply, sum_comp_mul, proj_comp_mul]

/-- The `i`-th map of this BD package is inductively defined
as the simplest solution to the homotopy condition,
so that the homotopy will consist of identity maps. -/
def map : Π n, rank (n+1) ⟶ rank n
| 0     := σπ 1
| (n+1) := σπ (rank (n+1)) - mul 2 (map n)

lemma map_succ (n : ℕ) : map (n+1) = σπ (rank (n+1)) - mul 2 (map n) := rfl

lemma is_complex_zero : map 1 ≫ map 0 = 0 :=
show comp (σπ 1) (σπ 2 - mul 2 (σπ 1)) = 0,
by { rw [add_monoid_hom.map_sub, σπ_comp_mul_two, sub_eq_zero], refl }

lemma is_complex_succ (n : ℕ) (ih : (comp (map n)) (map (n + 1)) = 0) :
  comp (map (n+1)) (map (n+1+1)) = 0 :=
by rw [map_succ (n+1), add_monoid_hom.map_sub, ← σπ_comp_mul_two, ← add_monoid_hom.sub_apply,
    ← add_monoid_hom.map_sub, map_succ n, sub_sub_cancel, ← mul_comp, ← map_succ, ih,
    add_monoid_hom.map_zero]

/-- The Breen--Deligne data for the example BD package. -/
def BD : data :=
{ X := rank,
  d := λ i j, if h : j + 1 = i then by subst h; exact map j else 0,
  shape' := λ i j h, dif_neg h,
  d_comp_d' :=
  begin
    rintro i j k (rfl : j + 1 = i) (rfl : k + 1 = j),
    simp only [dif_pos rfl],
    induction k with k ih,
    { exact is_complex_zero },
    { exact is_complex_succ k ih }
  end }

open category_theory category_theory.limits category_theory.preadditive
open homological_complex

/-- The `n`-th homotopy map for the example BD package is the identity. -/
def hmap : Π (j i : ℕ) (h : j + 1 = i), (((data.mul 2).obj BD).X j) ⟶ (BD.X i)
| j i rfl := 𝟙 _

/-- The identity maps form a homotopy between the chain maps `proj 2` and `sum 2`
for the Breen--Deligne data `eg.BD`. -/
def h : homotopy (BD.proj 2) (BD.sum 2) :=
{ hom := λ j i, if h : j + 1 = i then hmap j i h else 0,
  zero' := λ i j h, dif_neg h,
  comm :=
  begin
    intros j,
    rw [d_next_nat, prev_d_eq], swap 2, { dsimp, refl },
    cases j,
    { dsimp, rw [dif_pos rfl, dif_neg, comp_zero, zero_add],
      swap, { dec_trivial },
      dsimp [BD, hmap, map, σπ],
      erw [dif_pos rfl, category.id_comp, ← sub_eq_iff_eq_add], refl, },
    { rw [dif_pos rfl, dif_pos], swap 2, { refl },
      dsimp [BD, hmap, map, σπ],
      erw [dif_pos rfl, dif_pos rfl, category.id_comp],
      dsimp [nat.succ_eq_add_one],
      erw [hmap, category.comp_id, ← sub_eq_iff_eq_add, add_sub, eq_comm, sub_eq_iff_eq_add'],
      refl },
  end }

end eg

/-- An example of a Breen--Deligne package coming from a nontrivial complex. -/
def eg : package := ⟨eg.BD, eg.h⟩

namespace eg

noncomputable theory

variables (r r' : ℝ≥0) [fact (r < 1)]

/-- Very suitable sequence of constants for the example Breen--Deligne package -/
def κ : ℕ → ℝ≥0 :=
eg.data.κ r r'

instance very_suitable [fact (0 < r')] : eg.data.very_suitable r r' (κ r r') :=
eg.data.c_very_suitable _ _

instance [fact (0 < r')] (n : ℕ) : fact (0 < κ r r' n) :=
data.c__pos _ _ _ _

/-- Adept sequence of constants for the example Breen--Deligne package -/
def κ' : ℕ → ℝ≥0 :=
eg.κ' (eg.κ r r')

instance adept [fact (0 < r')] : package.adept eg (κ r r') (κ' r r') :=
eg.κ'_adept _

end eg

end breen_deligne

#lint-


/-
Copyright (c) 2021 Paul Lezeau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Paul Lezeau
-/
import algebra.is_prime_pow
import algebra.squarefree

/-!

# Chains of divisors

The results in this file show that in the monoid `associates M` of a `unique_factorization_monoid`
`M`, an element `a` is an n-th prime power iff its set of divisors is a strictly increasing chain
of length `n + 1`, meaning that we can find a strictly increasing bijection between `fin (n + 1)`
and the set of factors of `a`.

## Main results
- `divisor_chain.exists_chain_of_prime_pow` : existence of a chain for prime powers.
- `divisor_chain.is_prime_pow_of_has_chain` : elements that have a chain are prime powers.
- `multiplicity_prime_le_multiplicity_image_by_factor_order_iso` : if there is a
  monotone bijection `d` between the set of factors of `a : associates M` and the set of factors of
  `b : associates N`, then, for any prime `p ∣ a`, `multiplicity p a ≤ multiplicity (d p) b`.

## Todo
- Show that under the assumptions of `multiplicity_prime_le_multiplicity_image_by_factor_order_iso`,
  `d p` is prime whenever `p` is prime. Applying
  `multiplicity_prime_le_multiplicity_image_by_factor_order_iso` on `d.symm` then gives us
  `multiplicity p a = multiplicity (d p) b`.
- Create a structure for chains of divisors.

-/

variables {M : Type*} [cancel_comm_monoid_with_zero M]

open unique_factorization_monoid multiplicity irreducible

namespace divisor_chain

lemma exists_chain_of_prime_pow {p : associates M} {n : ℕ} (hn : n ≠ 0) (hp : prime p) :
  ∃ c : fin (n + 1) → associates M,
    c 1 = p ∧ strict_mono c ∧
    ∀ {r : associates M}, r ≤ p^n ↔ ∃ i, r = c i :=
begin
  refine ⟨λ i, p^(i : ℕ), _, λ n m h, _, λ y, ⟨λ h, _, _⟩⟩,
  { rw [fin.coe_one', nat.mod_eq_of_lt, pow_one],
    exact nat.lt_succ_of_le (nat.one_le_iff_ne_zero.mpr hn) },
  { exact associates.dvd_not_unit_iff_lt.mp ⟨pow_ne_zero n hp.ne_zero, p^(m - n : ℕ),
      not_is_unit_of_not_is_unit_dvd hp.not_unit (dvd_pow dvd_rfl (nat.sub_pos_of_lt h).ne'),
      (pow_mul_pow_sub p h.le).symm⟩ },
  { obtain ⟨i, i_le, hi⟩ := (dvd_prime_pow hp n).1 h,
    rw associated_iff_eq at hi,
    exact ⟨⟨i, nat.lt_succ_of_le i_le⟩, hi⟩ },
  { rintro ⟨i, rfl⟩,
    exact ⟨p^(n - i : ℕ), (pow_mul_pow_sub p (nat.succ_le_succ_iff.mp i.2)).symm⟩ }
end

lemma element_of_chain_not_is_unit_of_index_ne_zero {n : ℕ} {i : fin (n + 1)} (i_pos : i ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c) :
  ¬ is_unit (c i) :=
dvd_not_unit.not_unit (associates.dvd_not_unit_iff_lt.2
  (h₁ $ show (0 : fin (n + 1)) < i, from i.pos_iff_ne_zero.mpr i_pos))

lemma first_of_chain_is_unit {q : associates M} {n : ℕ} {c : fin (n + 1) → associates M}
  (h₁ : strict_mono c) (h₂ : ∀ {r}, r ≤ q ↔ ∃ i, r = c i) : is_unit (c 0) :=
begin
  obtain ⟨i, hr⟩ := h₂.mp associates.one_le,
  rw [associates.is_unit_iff_eq_one, ← associates.le_one_iff, hr],
  exact h₁.monotone (fin.zero_le i)
end

/-- The second element of a chain is irreducible. -/
lemma second_of_chain_is_irreducible {q : associates M} {n : ℕ} (hn : n ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c) (h₂ : ∀ {r}, r ≤ q ↔ ∃ i, r = c i)
  (hq : q ≠ 0) : irreducible (c 1) :=
begin
  cases n, { contradiction },
  refine (associates.is_atom_iff (ne_zero_of_dvd_ne_zero hq (h₂.2 ⟨1, rfl⟩))).mp ⟨_, λ b hb, _⟩,
  { exact ne_bot_of_gt (h₁ (show (0 : fin (n + 2)) < 1, from fin.one_pos)) },
  obtain ⟨⟨i, hi⟩, rfl⟩ := h₂.1 (hb.le.trans (h₂.2 ⟨1, rfl⟩)),
  cases i,
  { exact (associates.is_unit_iff_eq_one _).mp (first_of_chain_is_unit h₁ @h₂) },
  { simpa [fin.lt_iff_coe_lt_coe] using h₁.lt_iff_lt.mp hb },
end

lemma eq_second_of_chain_of_prime_dvd {p q r : associates M} {n : ℕ} (hn : n ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c)
  (h₂ : ∀ {r : associates M}, r ≤ q ↔ ∃ i, r = c i) (hp : prime p) (hr : r ∣ q) (hp' : p ∣ r) :
  p = c 1 :=
begin
  cases n,
  { contradiction },
  obtain ⟨i, rfl⟩ := h₂.1 (dvd_trans hp' hr),
  refine congr_arg c (eq_of_ge_of_not_gt _ $ λ hi, _),
  { rw [fin.le_iff_coe_le_coe, fin.coe_one, nat.succ_le_iff, ← fin.coe_zero,
        ← fin.lt_iff_coe_lt_coe, fin.pos_iff_ne_zero],
    rintro rfl,
    exact hp.not_unit (first_of_chain_is_unit h₁ @h₂) },
  obtain (rfl | ⟨j, rfl⟩) := i.eq_zero_or_eq_succ,
  { cases hi },
  refine not_irreducible_of_not_unit_dvd_not_unit
    (dvd_not_unit.not_unit (associates.dvd_not_unit_iff_lt.2
    (h₁ (show (0 : fin (n + 2)) < j, from _)) )) _ hp.irreducible,
  { simpa [← fin.succ_zero_eq_one, fin.succ_lt_succ_iff] using hi },
  { refine associates.dvd_not_unit_iff_lt.2 (h₁ _),
    simpa only [fin.coe_eq_cast_succ] using fin.lt_succ }
end

lemma card_subset_divisors_le_length_of_chain {q : associates M}
  {n : ℕ} {c : fin (n + 1) → associates M} (h₂ : ∀ {r}, r ≤ q ↔ ∃ i, r = c i)
  {m : finset (associates M)} (hm : ∀ r, r ∈ m → r ≤ q) : m.card ≤ n + 1 :=
begin
  classical,
  have mem_image : ∀ (r : associates M), r ≤ q → r ∈ finset.univ.image c,
  { intros r hr,
    obtain ⟨i, hi⟩ := h₂.1 hr,
    exact finset.mem_image.2 ⟨i, finset.mem_univ _, hi.symm⟩ },
  rw ←finset.card_fin (n + 1),
  exact (finset.card_le_of_subset $ λ x hx, mem_image x $ hm x hx).trans finset.card_image_le,
end

variables [unique_factorization_monoid M]

lemma element_of_chain_eq_pow_second_of_chain {q r : associates M} {n : ℕ} (hn : n ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c)
  (h₂ : ∀ {r}, r ≤ q ↔ ∃ i, r = c i) (hr : r ∣ q)
  (hq : q ≠ 0) : ∃ (i : fin (n + 1)), r = (c 1) ^ (i : ℕ) :=
begin
  classical,
  let i := (normalized_factors r).card,
  have hi : normalized_factors r = multiset.repeat (c 1) i,
  { apply multiset.eq_repeat_of_mem,
    intros b hb,
    refine eq_second_of_chain_of_prime_dvd hn h₁ (λ r', h₂) (prime_of_normalized_factor b hb) hr
      (dvd_of_mem_normalized_factors hb) },
  have H : r = (c 1)^i,
  { have := unique_factorization_monoid.normalized_factors_prod (ne_zero_of_dvd_ne_zero hq hr),
    rw [associated_iff_eq, hi, multiset.prod_repeat] at this,
    rw this },

  refine ⟨⟨i, _⟩, H⟩,
  have : (finset.univ.image (λ (m : fin (i + 1)), (c 1) ^ (m : ℕ))).card = i + 1,
  { conv_rhs { rw [← finset.card_fin (i+1)] },
    cases n, { contradiction },
    rw finset.card_image_eq_iff_inj_on,
    refine set.inj_on_of_injective (λ m m' h, fin.ext _) _,
    refine pow_injective_of_not_unit
      (element_of_chain_not_is_unit_of_index_ne_zero (by simp) h₁) _ h,
    exact irreducible.ne_zero (second_of_chain_is_irreducible hn h₁ @h₂ hq) },

  suffices H' : ∀ r ∈ (finset.univ.image (λ (m : fin (i + 1)), (c 1) ^ (m : ℕ))), r ≤ q,
  { simp only [← nat.succ_le_iff, nat.succ_eq_add_one, ← this],
    apply card_subset_divisors_le_length_of_chain @h₂ H' },

  simp only [finset.mem_image],
  rintros r ⟨a, ha, rfl⟩,
  refine dvd_trans _ hr,
  use (c 1)^(i - a),
  rw pow_mul_pow_sub (c 1),
  { exact H },
  { exact nat.succ_le_succ_iff.mp a.2 }
end

lemma eq_pow_second_of_chain_of_has_chain {q : associates M} {n : ℕ} (hn : n ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c)
  (h₂ : ∀ {r : associates M}, r ≤ q ↔ ∃ i, r = c i) (hq : q ≠ 0) : q = (c 1)^n :=
begin
  classical,
  obtain ⟨i, hi'⟩ := element_of_chain_eq_pow_second_of_chain hn h₁ (λ r, h₂) (dvd_refl q) hq,
  convert hi',
  refine (nat.lt_succ_iff.1 i.prop).antisymm' (nat.le_of_succ_le_succ _),
  calc n + 1 = (finset.univ : finset (fin (n + 1))).card : (finset.card_fin _).symm
         ... = (finset.univ.image c).card :
    (finset.card_image_eq_iff_inj_on.mpr (h₁.injective.inj_on _)).symm
         ... ≤ (finset.univ.image (λ (m : fin (i + 1)), (c 1)^(m : ℕ))).card :
          finset.card_le_of_subset _
         ... ≤ (finset.univ : finset (fin (i + 1))).card : finset.card_image_le
         ... = i + 1 : finset.card_fin _,
  intros r hr,
  obtain ⟨j, -, rfl⟩ := finset.mem_image.1 hr,
  have := h₂.2 ⟨j, rfl⟩,
  rw hi' at this,
  obtain ⟨u, hu, hu'⟩ := (dvd_prime_pow (show prime (c 1), from _) i).1 this,
  refine finset.mem_image.mpr ⟨u, finset.mem_univ _, _⟩,
  { rw associated_iff_eq at hu', rw [fin.coe_coe_of_lt (nat.lt_succ_of_le hu), hu'] },
  { rw ← irreducible_iff_prime, exact second_of_chain_is_irreducible hn h₁ @h₂ hq, }
end

lemma is_prime_pow_of_has_chain {q : associates M} {n : ℕ} (hn : n ≠ 0)
  {c : fin (n + 1) → associates M} (h₁ : strict_mono c)
  (h₂ : ∀ {r : associates M}, r ≤ q ↔ ∃ i, r = c i) (hq : q ≠ 0) : is_prime_pow q :=
⟨c 1, n, irreducible_iff_prime.mp (second_of_chain_is_irreducible hn h₁ @h₂ hq),
  zero_lt_iff.mpr hn, (eq_pow_second_of_chain_of_has_chain hn h₁ @h₂ hq).symm⟩

end divisor_chain

variables {N : Type*} [cancel_comm_monoid_with_zero N] [unique_factorization_monoid N]
  [decidable_eq (associates M)] [unique_factorization_monoid M]

open divisor_chain

lemma pow_image_of_prime_by_factor_order_iso_dvd {m p : associates M} {n : associates N}
  (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
  (d : {l : associates M // l ≤ m} ≃o {l : associates N // l ≤ n}) {s : ℕ} (hs : s ≠ 0)
  (hs' : p^s ≤ m) : (d ⟨p, dvd_of_mem_normalized_factors hp⟩ : associates N)^s ≤ n :=
begin
  suffices : (d ⟨p, dvd_of_mem_normalized_factors hp⟩ : associates N)^s = ↑(d ⟨p^s, hs'⟩),
  { rw this,
    apply subtype.prop (d ⟨p^s, hs'⟩) },
  obtain ⟨c₁, rfl, hc₁', hc₁''⟩ := exists_chain_of_prime_pow hs (prime_of_normalized_factor p hp),

  set c₂ : fin (s + 1) → associates N := λ t, d ⟨c₁ t, le_trans (hc₁''.2 ⟨t, by simp⟩) hs'⟩,
  have c₂.def : ∀ (t), c₂ t = d ⟨c₁ t, _⟩ := λ t, rfl,
  refine (congr_arg (^s) (c₂.def 1).symm).trans _,
  refine (eq_pow_second_of_chain_of_has_chain hs (λ t u h, _) (λ r, ⟨λ hr, _, _⟩) _).symm,
  { rw [c₂.def, c₂.def, subtype.coe_lt_coe, d.lt_iff_lt, subtype.mk_lt_mk, (hc₁').lt_iff_lt],
    exact h },
  { have : r ≤ n := hr.trans (d ⟨c₁ 1 ^ s, _⟩).2,
    suffices : d.symm ⟨r, this⟩ ≤ ⟨c₁ 1 ^ s, hs'⟩,
    { obtain ⟨i, hi⟩ := hc₁''.1 this,
      use i,
      simp only [c₂.def, ← hi, d.apply_symm_apply, subtype.coe_eta, subtype.coe_mk] },
    conv_rhs { rw ← d.symm_apply_apply ⟨c₁ 1 ^ s, hs'⟩ },
    rw d.symm.le_iff_le,
    simpa only [← subtype.coe_le_coe, subtype.coe_mk] using hr },
  { rintros ⟨i, hr⟩,
    rw [hr, c₂.def, subtype.coe_le_coe, d.le_iff_le],
    simpa [subtype.mk_le_mk] using hc₁''.2 ⟨i, rfl⟩ },
  exact ne_zero_of_dvd_ne_zero hn (subtype.prop (d ⟨c₁ 1 ^ s, _⟩))
end

variables [decidable_rel ((∣) : associates M → associates M → Prop)]
 [decidable_rel ((∣) : associates N → associates N → Prop)]

lemma multiplicity_prime_le_multiplicity_image_by_factor_order_iso {m p : associates M}
  {n : associates N} (hm : m ≠ 0) (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
  (d : {l : associates M // l ≤ m} ≃o {l : associates N // l ≤ n}) :
  multiplicity p m ≤ multiplicity ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) n :=
begin
  rw [←enat.coe_get (finite_iff_dom.1 $ finite_prime_left (prime_of_normalized_factor p hp) hm),
    ←pow_dvd_iff_le_multiplicity],
  refine pow_image_of_prime_by_factor_order_iso_dvd hn hp d (λ H, _) (pow_multiplicity_dvd _),
  refine (dvd_of_mem_normalized_factors hp).multiplicity_pos.ne' (part.eq_some_iff.mpr _),
  rw ←H,
  exact part.get_mem _,
end


@[simp] def List.pop : List α → List α × Option α
  | a :: t => (t, a)
  | _      => ([], none)

@[simp] def List.push : List α → Option α → List α
  | l, some a => (a :: l)
  | l, none   => l

@[simp] def List.ascending {α : Type} [LT α] : List α → Prop
  | a :: b :: t => a < b ∧ ascending (b :: t)
  | _           => True

theorem List.nonEmptyIff {l : List α} : l ≠ [] ↔ 0 ≠ l.length := sorry

theorem Nat.zeroNeSumOne {a : Nat} : 0 ≠ a + 1 := by
  simp [Ne.symm, succ_ne_zero a]

inductive Tower | L | M | R

open Tower

instance : ToString Tower where
  toString := fun t => match t with
    | L => "L" | M => "M" | R => "R"

abbrev Move := Tower × Tower

structure Hanoi where
  (l : List Nat) (m : List Nat) (r : List Nat)

namespace Hanoi

def new (n : Nat) : Hanoi :=
  ⟨List.range n, [], []⟩

def solve' : Tower × Tower × Tower → Nat → List Move → List Move
  | _ ,           0,     m => m
  | ⟨t₁, t₂, t₃⟩, n + 1, m =>
    solve' ⟨t₂, t₁, t₃⟩ n ((t₁, t₃) :: (solve' ⟨t₁, t₃, t₂⟩ n m))

def solve (n : Nat) : List Move :=
  solve' ⟨L, M, R⟩ n [] |>.reverse

def apply : Hanoi → Move → Hanoi
  | han, (L, M) => let pop := han.l.pop; ⟨pop.fst, han.m.push pop.snd, han.r⟩
  | han, (L, R) => let pop := han.l.pop; ⟨pop.fst, han.m, han.r.push pop.snd⟩
  | han, (M, L) => let pop := han.m.pop; ⟨han.l.push pop.snd, pop.fst, han.r⟩
  | han, (M, R) => let pop := han.m.pop; ⟨han.l, pop.fst, han.r.push pop.snd⟩
  | han, (R, L) => let pop := han.r.pop; ⟨han.l.push pop.snd, han.m, pop.fst⟩
  | han, (R, M) => let pop := han.r.pop; ⟨han.l, han.m.push pop.snd, pop.fst⟩
  | han, _      => han

def applyMoves' : List Hanoi → List Move → List Hanoi
  | han :: hans, m :: ms => (han.apply m) :: (applyMoves' (han :: hans) ms)
  | hans, [] => hans
  | [], _ => []

def applyMoves (han : Hanoi) (ms : List Move) : List Hanoi :=
  applyMoves' [han] ms

@[simp] def isStart (han : Hanoi) : Prop :=
  han.l.ascending ∧ han.m = [] ∧ han.r = []

@[simp] def isSolved (han : Hanoi) : Prop :=
  han.l = [] ∧ han.m = [] ∧ han.r.ascending

@[simp] def isValid (han : Hanoi) : Prop :=
  han.l.ascending ∧ han.m.ascending ∧ han.r.ascending

def areValid : List (Hanoi) → Prop
  | han :: hans => han.isValid ∧ areValid hans
  | []          => True

@[simp] def solutionOf (n : Nat) : List Hanoi :=
  (Hanoi.new n).applyMoves (solve n)

theorem validOfStart {han : Hanoi} (h : han.isStart) :
  han.isValid := by simp at h; simp [h]

theorem validOfSolved {han : Hanoi} (h : han.isSolved) :
  han.isValid := by simp at h; simp [h]

theorem sizeOfSolutionSucc {n : Nat} :
    (solutionOf (n + 1)).length = 2 * (solutionOf n).length + 1 := sorry

theorem solutionNotEmpty {n : Nat} : solutionOf n ≠ [] := by
  cases n with
    | zero => simp [applyMoves, applyMoves']
    | succ m =>
      -- relying on `sizeOfSolutionSucc`, really?! this should be much weaker!
      rw [List.nonEmptyIff, sizeOfSolutionSucc]
      simp [Nat.zeroNeSumOne]

theorem solvedForAll {n : Nat} :
  (solutionOf n).head solutionNotEmpty |>.isSolved := sorry

theorem validForAll {n : Nat} : areValid (solutionOf n) := sorry

end Hanoi


import data.real.basic

notation `|`x`|` := abs x

/-
Dette projekt har til formål at formalisere koncepter fra reel analyse (Analyse 0).
-/

namespace real_analysis

def upper_bound (u : ℕ → ℝ) (b : ℝ) := ∀ (n:ℕ), u n ≤ b

example : upper_bound (λ n, 1) 1 :=
begin
  sorry
end

/-
Provide the definition from your analysis course.
You can remove the part `: Prop ` once you have specified a Prop type on the right of `:=` because Lean will figure it out by itself.
-/
def seq_limit (fill_this : Type) (x : ℝ) : Prop := sorry

def continuous_at (f : ℝ → ℝ) (x₀ : ℝ) : Prop := sorry

theorem continuous_comp (f g : ℝ → ℝ) (x₀ : ℝ) (hf : continuous_at f (g x₀)) (hg : continuous_at g x₀)
  : continuous_at (f ∘ g) x₀ :=
begin
  sorry
end

/-
Der er adskillige sætninger fra analysen som vi kan bevise ved hjælp af grænseværdibegræbet.
Et mål kunne være at bevise skæringssætningen.
-/

end real_analysis


def f (x : Nat) := x

theorem ex1 (h₁ : a = 0) (h₂ : a + b = 0) : f (b + c) = c := by
  simp_all
  simp [f]

theorem ex2 (h₁ : a = 0) (h₂ : a + b = 0) : f (b + c) = c := by
  simp_all [f]

theorem ex3 (h₁ : a = 0) (h₂ : a + b = 0) : f (b + c) = c := by
  simp_all only [f]
  rw [Nat.zero_add] at h₂
  simp [h₂]

theorem ex4 (h₁ : a = f a) (h₂ : b + 0 = 0) : f b = 0 := by
  simp_all [-h₁]

theorem ex5 (h₁ : a = f a) (h₂ : b + 0 = 0) : f (b + a) = a := by
  simp_all [-h₁, f]


universe u

namespace hidden

variables {α β γ : Type u}

example : inhabited bool := inhabited.mk tt
example : inhabited nat := inhabited.mk 0

def partial_composite (f : α → option β) (g : β → option γ) (x : α) : option γ
:= option.rec_on (f x) none (λ x, g x)

def func1 (n : nat) : option nat := cond (2 ∣ n) (some n) none
def func2 (n : nat) : option nat := cond (4 ∣ n) (some n) none

def f12 : nat → option nat := partial_composite func1 func2

#eval f12 2
#eval f12 3
#eval f12 4
#eval f12 8
#eval f12 9

end hidden


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los anillos,
--    0 * a = 0
-- ----------------------------------------------------------------------

import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]

variable (a : R)

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

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : (add_mul 0 0 a).symm
     ... = 0 * a       : congr_arg (λ x, x * a) (add_zero 0)
     ... = 0 * a + 0   : self_eq_add_right.mpr rfl,
  rw add_left_cancel h
end

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

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : by rw add_mul
     ... = 0 * a       : by rw add_zero
     ... = 0 * a + 0   : by rw add_zero,
  rw add_left_cancel h
end

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

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
  { rw [←add_mul, add_zero, add_zero] },
  rw add_left_cancel h
end

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

example : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
    calc 0 * a + 0 * a
         = (0 + 0) * a : by simp
     ... = 0 * a       : by simp
     ... = 0 * a + 0   : by simp,
  simp,
end

end my_ring


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

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_252 :
  (nat.factorial 7) % 23 = 3 :=
begin
  norm_num,
end


import ring_theory.ideal.operations

lemma ideal.colon_top {R : Type*} [comm_ring R] (I : ideal R) :
  I.colon ⊤ = I :=
begin
  suffices : ∀ (x : R), (∀ (p : R), x * p ∈ I) ↔ x ∈ I,
  { simpa [set_like.ext_iff, submodule.mem_colon] },
  exact λ x, ⟨λ h, mul_one x ▸ h 1, λ h y, I.mul_mem_right y h⟩,
end

lemma ideal.quotient.lift_comp {R S : Type*} [comm_ring R] [comm_ring S]
  (I : ideal R) (f : R →+* S) (H : ∀ (a : R), a ∈ I → f a = 0) :
  (I^.quotient.lift f H).comp I^.quotient.mk = f :=
ring_hom.ext (λ _, rfl)

lemma ideal.map_comp {R A B : Type*} [comm_ring R] [comm_ring A] [comm_ring B]
  (f : R →+* A) (g : A →+* B) (I : ideal R) :
  I.map (g.comp f) = (I.map f).map g :=
begin
  change _ = (ideal.span _).map g,
  rw [ideal.map_span, ← set.image_comp],
  refl,
end


variables (U : Type) ( x y : U)
variables R : U → U → Prop
example : (∃ x,∀ y,R x y) → ∀ y, ∃ x,R x y :=
assume h1 : ∃ x,∀ y,R x y,
exists.elim h1 $
assume t (h2: ∀ y, R t y),
assume u,
have h3 : R t u, from h2 u,
show ∃ x, R x u, from exists.intro t h3


inductive threeorfour : nat -> Prop
| isthree : forall (n : nat),  n=3 -> threeorfour n
| isfour  : forall (n : nat),  n=4 -> threeorfour n

/-- Coq Inversion -> Lean cases -/
lemma threeorfour_def : forall n, threeorfour n -> n=3 ∨ n=4 :=
begin
intros,
/-Inversion here-/
cases a,
{ left, assumption},
{ right, assumption},
end


def g (x : Nat) := 2*x + 1

def f (x : Nat) : Nat :=
  match g x with
  | 0 => 1
  | y + 1 => g x

example : f x = 2*x + 1 := by
  unfold f
  split
  next h => simp_arith [g] at h
  next y h =>
    trace_state
    -- split tactic should *not* rewrite `g x` to `Nat.succ y`
    show g x = 2*x + 1
    simp [g]


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

! This file was ported from Lean 3 source module model_theory.fraisse
! leanprover-community/mathlib commit 0602c59878ff3d5f71dea69c2d32ccf2e93e5398
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.ModelTheory.FinitelyGenerated
import Mathbin.ModelTheory.DirectLimit
import Mathbin.ModelTheory.Bundled

/-!
# Fraïssé Classes and Fraïssé Limits

This file pertains to the ages of countable first-order structures. The age of a structure is the
class of all finitely-generated structures that embed into it.

Of particular interest are Fraïssé classes, which are exactly the ages of countable
ultrahomogeneous structures. To each is associated a unique (up to nonunique isomorphism)
Fraïssé limit - the countable ultrahomogeneous structure with that age.

## Main Definitions
* `first_order.language.age` is the class of finitely-generated structures that embed into a
particular structure.
* A class `K` has the `first_order.language.hereditary` when all finitely-generated
structures that embed into structures in `K` are also in `K`.
* A class `K` has the `first_order.language.joint_embedding` when for every `M`, `N` in
`K`, there is another structure in `K` into which both `M` and `N` embed.
* A class `K` has the `first_order.language.amalgamation` when for any pair of embeddings
of a structure `M` in `K` into other structures in `K`, those two structures can be embedded into a
fourth structure in `K` such that the resulting square of embeddings commutes.
* `first_order.language.is_fraisse` indicates that a class is nonempty, isomorphism-invariant,
essentially countable, and satisfies the hereditary, joint embedding, and amalgamation properties.
* `first_order.language.is_fraisse_limit` indicates that a structure is a Fraïssé limit for a given
class.

## Main Results
* We show that the age of any structure is isomorphism-invariant and satisfies the hereditary and
joint-embedding properties.
* `first_order.language.age.countable_quotient` shows that the age of any countable structure is
essentially countable.
* `first_order.language.exists_countable_is_age_of_iff` gives necessary and sufficient conditions
for a class to be the age of a countable structure in a language with countably many functions.

## Implementation Notes
* Classes of structures are formalized with `set (bundled L.Structure)`.
* Some results pertain to countable limit structures, others to countably-generated limit
structures. In the case of a language with countably many function symbols, these are equivalent.

## References
- [W. Hodges, *A Shorter Model Theory*][Hodges97]
- [K. Tent, M. Ziegler, *A Course in Model Theory*][Tent_Ziegler]

## TODO
* Show existence and uniqueness of Fraïssé limits

-/

universe u v w w'

open FirstOrder

open Set CategoryTheory

namespace FirstOrder

namespace Language

open Structure Substructure

variable (L : Language.{u, v})

/-! ### The Age of a Structure and Fraïssé Classes-/

/-- The age of a structure `M` is the class of finitely-generated structures that embed into it. -/
def age (M : Type w) [L.Structure M] : Set (Bundled.{w} L.Structure) :=
  { N | Structure.Fg L N ∧ Nonempty (N ↪[L] M) }
#align first_order.language.age FirstOrder.Language.age

variable {L} (K : Set (Bundled.{w} L.Structure))

/-- A class `K` has the hereditary property when all finitely-generated structures that embed into
  structures in `K` are also in `K`.  -/
def Hereditary : Prop :=
  ∀ M : Bundled.{w} L.Structure, M ∈ K → L.age M ⊆ K
#align first_order.language.hereditary FirstOrder.Language.Hereditary

/-- A class `K` has the joint embedding property when for every `M`, `N` in `K`, there is another
  structure in `K` into which both `M` and `N` embed. -/
def JointEmbedding : Prop :=
  DirectedOn (fun M N : Bundled.{w} L.Structure => Nonempty (M ↪[L] N)) K
#align first_order.language.joint_embedding FirstOrder.Language.JointEmbedding

/-- A class `K` has the amalgamation property when for any pair of embeddings of a structure `M` in
  `K` into other structures in `K`, those two structures can be embedded into a fourth structure in
  `K` such that the resulting square of embeddings commutes. -/
def Amalgamation : Prop :=
  ∀ (M N P : Bundled.{w} L.Structure) (MN : M ↪[L] N) (MP : M ↪[L] P),
    M ∈ K →
      N ∈ K →
        P ∈ K →
          ∃ (Q : Bundled.{w} L.Structure)(NQ : N ↪[L] Q)(PQ : P ↪[L] Q),
            Q ∈ K ∧ NQ.comp MN = PQ.comp MP
#align first_order.language.amalgamation FirstOrder.Language.Amalgamation

/-- A Fraïssé class is a nonempty, isomorphism-invariant, essentially countable class of structures
satisfying the hereditary, joint embedding, and amalgamation properties. -/
class IsFraisse : Prop where
  is_nonempty : K.Nonempty
  Fg : ∀ M : Bundled.{w} L.Structure, M ∈ K → Structure.Fg L M
  is_equiv_invariant : ∀ M N : Bundled.{w} L.Structure, Nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K)
  is_essentially_countable : (Quotient.mk' '' K).Countable
  Hereditary : Hereditary K
  JointEmbedding : JointEmbedding K
  Amalgamation : Amalgamation K
#align first_order.language.is_fraisse FirstOrder.Language.IsFraisse

variable {K} (L) (M : Type w) [L.Structure M]

theorem age.is_equiv_invariant (N P : Bundled.{w} L.Structure) (h : Nonempty (N ≃[L] P)) :
    N ∈ L.age M ↔ P ∈ L.age M :=
  and_congr h.some.fg_iff
    ⟨Nonempty.map fun x => Embedding.comp x h.some.symm.toEmbedding,
      Nonempty.map fun x => Embedding.comp x h.some.toEmbedding⟩
#align first_order.language.age.is_equiv_invariant FirstOrder.Language.age.is_equiv_invariant

variable {L} {M} {N : Type w} [L.Structure N]

theorem Embedding.age_subset_age (MN : M ↪[L] N) : L.age M ⊆ L.age N := fun _ =>
  And.imp_right (Nonempty.map MN.comp)
#align first_order.language.embedding.age_subset_age FirstOrder.Language.Embedding.age_subset_age

theorem Equiv.age_eq_age (MN : M ≃[L] N) : L.age M = L.age N :=
  le_antisymm MN.toEmbedding.age_subset_age MN.symm.toEmbedding.age_subset_age
#align first_order.language.equiv.age_eq_age FirstOrder.Language.Equiv.age_eq_age

theorem Structure.Fg.mem_age_of_equiv {M N : Bundled L.Structure} (h : Structure.Fg L M)
    (MN : Nonempty (M ≃[L] N)) : N ∈ L.age M :=
  ⟨MN.some.fg_iff.1 h, ⟨MN.some.symm.toEmbedding⟩⟩
#align first_order.language.Structure.fg.mem_age_of_equiv FirstOrder.Language.Structure.Fg.mem_age_of_equiv

theorem Hereditary.is_equiv_invariant_of_fg (h : Hereditary K)
    (fg : ∀ M : Bundled.{w} L.Structure, M ∈ K → Structure.Fg L M) (M N : Bundled.{w} L.Structure)
    (hn : Nonempty (M ≃[L] N)) : M ∈ K ↔ N ∈ K :=
  ⟨fun MK => h M MK ((fg M MK).mem_age_of_equiv hn), fun NK =>
    h N NK ((fg N NK).mem_age_of_equiv ⟨hn.some.symm⟩)⟩
#align first_order.language.hereditary.is_equiv_invariant_of_fg FirstOrder.Language.Hereditary.is_equiv_invariant_of_fg

variable (M)

theorem age.nonempty : (L.age M).Nonempty :=
  ⟨Bundled.of (Substructure.closure L (∅ : Set M)),
    (fg_iff_structure_fg _).1 (fg_closure Set.finite_empty), ⟨Substructure.subtype _⟩⟩
#align first_order.language.age.nonempty FirstOrder.Language.age.nonempty

theorem age.hereditary : Hereditary (L.age M) := fun N hN P hP => hN.2.some.age_subset_age hP
#align first_order.language.age.hereditary FirstOrder.Language.age.hereditary

theorem age.jointEmbedding : JointEmbedding (L.age M) := fun N hN P hP =>
  ⟨Bundled.of ↥(hN.2.some.toHom.range ⊔ hP.2.some.toHom.range),
    ⟨(fg_iff_structure_fg _).1 ((hN.1.range hN.2.some.toHom).sup (hP.1.range hP.2.some.toHom)),
      ⟨Subtype _⟩⟩,
    ⟨Embedding.comp (inclusion le_sup_left) hN.2.some.equivRange.toEmbedding⟩,
    ⟨Embedding.comp (inclusion le_sup_right) hP.2.some.equivRange.toEmbedding⟩⟩
#align first_order.language.age.joint_embedding FirstOrder.Language.age.jointEmbedding

/-- The age of a countable structure is essentially countable (has countably many isomorphism
classes). -/
theorem age.countable_quotient [h : Countable M] : (Quotient.mk' '' L.age M).Countable := by
  classical
    refine'
      (congr_arg _ (Set.ext <| forall_quotient_iff.2 fun N => _)).mp
        (countable_range fun s : Finset M => ⟦⟨closure L (s : Set M), inferInstance⟩⟧)
    simp only [mem_image, mem_range, mem_set_of_eq, Quotient.eq']
    constructor
    · rintro ⟨s, hs⟩
      use bundled.of ↥(closure L (s : Set M))
      exact ⟨⟨(fg_iff_Structure_fg _).1 (fg_closure s.finite_to_set), ⟨Subtype _⟩⟩, hs⟩
    · rintro ⟨P, ⟨⟨s, hs⟩, ⟨PM⟩⟩, hP2⟩
      refine' ⟨s.image PM, Setoid.trans _ hP2⟩
      rw [← embedding.coe_to_hom, Finset.coe_image, closure_image PM.to_hom, hs, ← hom.range_eq_map]
      exact ⟨PM.equiv_range.symm⟩
#align first_order.language.age.countable_quotient FirstOrder.Language.age.countable_quotient

/-- The age of a direct limit of structures is the union of the ages of the structures. -/
@[simp]
theorem age_directLimit {ι : Type w} [Preorder ι] [IsDirected ι (· ≤ ·)] [Nonempty ι]
    (G : ι → Type max w w') [∀ i, L.Structure (G i)] (f : ∀ i j, i ≤ j → G i ↪[L] G j)
    [DirectedSystem G fun i j h => f i j h] : L.age (DirectLimit G f) = ⋃ i : ι, L.age (G i) := by
  classical
    ext M
    simp only [mem_Union]
    constructor
    · rintro ⟨Mfg, ⟨e⟩⟩
      obtain ⟨s, hs⟩ := Mfg.range e.to_hom
      let out := @Quotient.out _ (direct_limit.setoid G f)
      obtain ⟨i, hi⟩ := Finset.exists_le (s.image (Sigma.fst ∘ out))
      have e' := (direct_limit.of L ι G f i).equivRange.symm.toEmbedding
      refine' ⟨i, Mfg, ⟨e'.comp ((substructure.inclusion _).comp e.equiv_range.to_embedding)⟩⟩
      rw [← hs, closure_le]
      intro x hx
      refine' ⟨f (out x).1 i (hi (out x).1 (Finset.mem_image_of_mem _ hx)) (out x).2, _⟩
      rw [embedding.coe_to_hom, direct_limit.of_apply, Quotient.mk_eq_iff_out,
        direct_limit.equiv_iff G f _ (hi (out x).1 (Finset.mem_image_of_mem _ hx)),
        DirectedSystem.map_self]
      rfl
    · rintro ⟨i, Mfg, ⟨e⟩⟩
      exact ⟨Mfg, ⟨Embedding.comp (direct_limit.of L ι G f i) e⟩⟩
#align first_order.language.age_direct_limit FirstOrder.Language.age_directLimit

/-- Sufficient conditions for a class to be the age of a countably-generated structure. -/
theorem exists_cg_is_age_of (hn : K.Nonempty)
    (h : ∀ M N : Bundled.{w} L.Structure, Nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K))
    (hc : (Quotient.mk' '' K).Countable)
    (fg : ∀ M : Bundled.{w} L.Structure, M ∈ K → Structure.Fg L M) (hp : Hereditary K)
    (jep : JointEmbedding K) : ∃ M : Bundled.{w} L.Structure, Structure.Cg L M ∧ L.age M = K :=
  by
  obtain ⟨F, hF⟩ := hc.exists_eq_range (hn.image _)
  simp only [Set.ext_iff, forall_quotient_iff, mem_image, mem_range, Quotient.eq'] at hF
  simp_rw [Quotient.eq_mk_iff_out] at hF
  have hF' : ∀ n : ℕ, (F n).out ∈ K := by
    intro n
    obtain ⟨P, hP1, hP2⟩ := (hF (F n).out).2 ⟨n, Setoid.refl _⟩
    exact (h _ _ hP2).1 hP1
  choose P hPK hP hFP using fun (N : K) (n : ℕ) => jep N N.2 (F (n + 1)).out (hF' _)
  let G : ℕ → K := @Nat.rec (fun _ => K) ⟨(F 0).out, hF' 0⟩ fun n N => ⟨P N n, hPK N n⟩
  let f : ∀ i j, i ≤ j → G i ↪[L] G j := directed_system.nat_le_rec fun n => (hP _ n).some
  refine'
    ⟨bundled.of (direct_limit (fun n => G n) f), direct_limit.cg _ fun n => (fg _ (G n).2).Cg,
      (age_direct_limit _ _).trans
        (subset_antisymm (Union_subset fun n N hN => hp (G n) (G n).2 hN) fun N KN => _)⟩
  obtain ⟨n, ⟨e⟩⟩ := (hF N).1 ⟨N, KN, Setoid.refl _⟩
  refine' mem_Union_of_mem n ⟨fg _ KN, ⟨Embedding.comp _ e.symm.to_embedding⟩⟩
  cases n
  · exact embedding.refl _ _
  · exact (hFP _ n).some
#align first_order.language.exists_cg_is_age_of FirstOrder.Language.exists_cg_is_age_of

theorem exists_countable_is_age_of_iff [Countable (Σl, L.Functions l)] :
    (∃ M : Bundled.{w} L.Structure, Countable M ∧ L.age M = K) ↔
      K.Nonempty ∧
        (∀ M N : Bundled.{w} L.Structure, Nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K)) ∧
          (Quotient.mk' '' K).Countable ∧
            (∀ M : Bundled.{w} L.Structure, M ∈ K → Structure.Fg L M) ∧
              Hereditary K ∧ JointEmbedding K :=
  by
  constructor
  · rintro ⟨M, h1, h2, rfl⟩
    skip
    refine'
      ⟨age.nonempty M, age.is_equiv_invariant L M, age.countable_quotient M, fun N hN => hN.1,
        age.hereditary M, age.joint_embedding M⟩
  · rintro ⟨Kn, eqinv, cq, hfg, hp, jep⟩
    obtain ⟨M, hM, rfl⟩ := exists_cg_is_age_of Kn eqinv cq hfg hp jep
    exact ⟨M, Structure.cg_iff_countable.1 hM, rfl⟩
#align first_order.language.exists_countable_is_age_of_iff FirstOrder.Language.exists_countable_is_age_of_iff

variable {K} (L) (M)

/-- A structure `M` is ultrahomogeneous if every embedding of a finitely generated substructure
into `M` extends to an automorphism of `M`. -/
def IsUltrahomogeneous : Prop :=
  ∀ (S : L.Substructure M) (hs : S.Fg) (f : S ↪[L] M),
    ∃ g : M ≃[L] M, f = g.toEmbedding.comp S.Subtype
#align first_order.language.is_ultrahomogeneous FirstOrder.Language.IsUltrahomogeneous

variable {L} (K)

/-- A structure `M` is a Fraïssé limit for a class `K` if it is countably generated,
ultrahomogeneous, and has age `K`. -/
@[protect_proj]
structure IsFraisseLimit [Countable (Σl, L.Functions l)] [Countable M] : Prop where
  ultrahomogeneous : IsUltrahomogeneous L M
  age : L.age M = K
#align first_order.language.is_fraisse_limit FirstOrder.Language.IsFraisseLimit

variable {L} {M}

theorem IsUltrahomogeneous.amalgamation_age (h : L.IsUltrahomogeneous M) : Amalgamation (L.age M) :=
  by
  rintro N P Q NP NQ ⟨Nfg, ⟨NM⟩⟩ ⟨Pfg, ⟨PM⟩⟩ ⟨Qfg, ⟨QM⟩⟩
  obtain ⟨g, hg⟩ :=
    h (PM.comp NP).toHom.range (Nfg.range _)
      ((QM.comp NQ).comp (PM.comp NP).equivRange.symm.toEmbedding)
  let s := (g.to_hom.comp PM.to_hom).range ⊔ QM.to_hom.range
  refine'
    ⟨bundled.of s,
      Embedding.comp (substructure.inclusion le_sup_left)
        (g.to_embedding.comp PM).equivRange.toEmbedding,
      Embedding.comp (substructure.inclusion le_sup_right) QM.equiv_range.to_embedding,
      ⟨(fg_iff_Structure_fg _).1 (fg.sup (Pfg.range _) (Qfg.range _)), ⟨substructure.subtype _⟩⟩, _⟩
  ext n
  have hgn := (embedding.ext_iff.1 hg) ((PM.comp NP).equivRange n)
  simp only [embedding.comp_apply, Equiv.coe_toEmbedding, Equiv.symm_apply_apply,
    substructure.coe_subtype, embedding.equiv_range_apply] at hgn
  simp only [embedding.comp_apply, Equiv.coe_toEmbedding, substructure.coe_inclusion,
    Set.coe_inclusion, embedding.equiv_range_apply, hgn]
#align first_order.language.is_ultrahomogeneous.amalgamation_age FirstOrder.Language.IsUltrahomogeneous.amalgamation_age

theorem IsUltrahomogeneous.age_isFraisse [Countable M] (h : L.IsUltrahomogeneous M) :
    IsFraisse (L.age M) :=
  ⟨age.nonempty M, fun _ hN => hN.1, age.is_equiv_invariant L M, age.countable_quotient M,
    age.hereditary M, age.jointEmbedding M, h.amalgamation_age⟩
#align first_order.language.is_ultrahomogeneous.age_is_fraisse FirstOrder.Language.IsUltrahomogeneous.age_isFraisse

namespace IsFraisseLimit

/-- If a class has a Fraïssé limit, it must be Fraïssé. -/
theorem isFraisse [Countable (Σl, L.Functions l)] [Countable M] (h : IsFraisseLimit K M) :
    IsFraisse K :=
  (congr rfl h.age).mp h.ultrahomogeneous.age_isFraisse
#align first_order.language.is_fraisse_limit.is_fraisse FirstOrder.Language.IsFraisseLimit.isFraisse

end IsFraisseLimit

end Language

end FirstOrder


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

/-!
# One-dimensional iterated derivatives

We define the `n`-th derivative of a function `f : 𝕜 → F` as a function
`iterated_deriv n f : 𝕜 → F`, as well as a version on domains `iterated_deriv_within n f s : 𝕜 → F`,
and prove their basic properties.

## Main definitions and results

Let `𝕜` be a nondiscrete normed field, and `F` a normed vector space over `𝕜`. Let `f : 𝕜 → F`.

* `iterated_deriv n f` is the `n`-th derivative of `f`, seen as a function from `𝕜` to `F`.
  It is defined as the `n`-th Fréchet derivative (which is a multilinear map) applied to the
  vector `(1, ..., 1)`, to take advantage of all the existing framework, but we show that it
  coincides with the naive iterative definition.
* `iterated_deriv_eq_iterate` states that the `n`-th derivative of `f` is obtained by starting
  from `f` and differentiating it `n` times.
* `iterated_deriv_within n f s` is the `n`-th derivative of `f` within the domain `s`. It only
  behaves well when `s` has the unique derivative property.
* `iterated_deriv_within_eq_iterate` states that the `n`-th derivative of `f` in the domain `s` is
  obtained by starting from `f` and differentiating it `n` times within `s`. This only holds when
  `s` has the unique derivative property.

## Implementation details

The results are deduced from the corresponding results for the more general (multilinear) iterated
Fréchet derivative. For this, we write `iterated_deriv n f` as the composition of
`iterated_fderiv 𝕜 n f` and a continuous linear equiv. As continuous linear equivs respect
differentiability and commute with differentiation, this makes it possible to prove readily that
the derivative of the `n`-th derivative is the `n+1`-th derivative in `iterated_deriv_within_succ`,
by translating the corresponding result `iterated_fderiv_within_succ_apply_left` for the
iterated Fréchet derivative.
-/

noncomputable theory
open_locale classical topological_space big_operators
open filter asymptotics set

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

/-- The `n`-th iterated derivative of a function from `𝕜` to `F`, as a function from `𝕜` to `F`. -/
def iterated_deriv (n : ℕ) (f : 𝕜 → F) (x : 𝕜) : F :=
(iterated_fderiv 𝕜 n f x : ((fin n) → 𝕜) → F) (λ(i : fin n), 1)

/-- The `n`-th iterated derivative of a function from `𝕜` to `F` within a set `s`, as a function
from `𝕜` to `F`. -/
def iterated_deriv_within (n : ℕ) (f : 𝕜 → F) (s : set 𝕜) (x : 𝕜) : F :=
(iterated_fderiv_within 𝕜 n f s x : ((fin n) → 𝕜) → F) (λ(i : fin n), 1)

variables {n : ℕ} {f : 𝕜 → F} {s : set 𝕜} {x : 𝕜}

lemma iterated_deriv_within_univ :
  iterated_deriv_within n f univ = iterated_deriv n f :=
by { ext x, rw [iterated_deriv_within, iterated_deriv, iterated_fderiv_within_univ] }

/-! ### Properties of the iterated derivative within a set -/

lemma iterated_deriv_within_eq_iterated_fderiv_within :
  iterated_deriv_within n f s x
  = (iterated_fderiv_within 𝕜 n f s x : ((fin n) → 𝕜) → F) (λ(i : fin n), 1) := rfl

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
lemma iterated_deriv_within_eq_equiv_comp :
  iterated_deriv_within n f s
  = (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F).symm ∘
    (iterated_fderiv_within 𝕜 n f s) :=
by { ext x, refl }

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
lemma iterated_fderiv_within_eq_equiv_comp :
  iterated_fderiv_within 𝕜 n f s
  = (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F) ∘ (iterated_deriv_within n f s) :=
begin
  rw [iterated_deriv_within_eq_equiv_comp, ← function.comp.assoc,
      continuous_linear_equiv.self_comp_symm],
  refl
end

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
lemma iterated_fderiv_within_apply_eq_iterated_deriv_within_mul_prod {m : (fin n) → 𝕜} :
  (iterated_fderiv_within 𝕜 n f s x : ((fin n) → 𝕜) → F) m
  = (∏ i, m i) • iterated_deriv_within n f s x :=
begin
  rw [iterated_deriv_within_eq_iterated_fderiv_within, ← continuous_multilinear_map.map_smul_univ],
  simp
end

@[simp] lemma iterated_deriv_within_zero :
  iterated_deriv_within 0 f s = f :=
by { ext x, simp [iterated_deriv_within] }

@[simp] lemma iterated_deriv_within_one (hs : unique_diff_on 𝕜 s) {x : 𝕜} (hx : x ∈ s):
  iterated_deriv_within 1 f s x = deriv_within f s x :=
by { simp [iterated_deriv_within, iterated_fderiv_within_one_apply hs hx], refl }

/-- If the first `n` derivatives within a set of a function are continuous, and its first `n-1`
derivatives are differentiable, then the function is `C^n`. This is not an equivalence in general,
but this is an equivalence when the set has unique derivatives, see
`times_cont_diff_on_iff_continuous_on_differentiable_on_deriv`. -/
lemma times_cont_diff_on_of_continuous_on_differentiable_on_deriv {n : with_top ℕ}
  (Hcont : ∀ (m : ℕ), (m : with_top ℕ) ≤ n →
    continuous_on (λ x, iterated_deriv_within m f s x) s)
  (Hdiff : ∀ (m : ℕ), (m : with_top ℕ) < n →
    differentiable_on 𝕜 (λ x, iterated_deriv_within m f s x) s) :
  times_cont_diff_on 𝕜 n f s :=
begin
  apply times_cont_diff_on_of_continuous_on_differentiable_on,
  { simpa [iterated_fderiv_within_eq_equiv_comp, continuous_linear_equiv.comp_continuous_on_iff] },
  { simpa [iterated_fderiv_within_eq_equiv_comp,
      continuous_linear_equiv.comp_differentiable_on_iff] }
end

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
lemma times_cont_diff_on_of_differentiable_on_deriv {n : with_top ℕ}
  (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) :
  times_cont_diff_on 𝕜 n f s :=
begin
  apply times_cont_diff_on_of_differentiable_on,
  simpa [iterated_fderiv_within_eq_equiv_comp,
    continuous_linear_equiv.comp_differentiable_on_iff, -coe_fn_coe_base],
end

/-- On a set with unique derivatives, a `C^n` function has derivatives up to `n` which are
continuous. -/
lemma times_cont_diff_on.continuous_on_iterated_deriv_within {n : with_top ℕ} {m : ℕ}
  (h : times_cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) ≤ n) (hs : unique_diff_on 𝕜 s) :
  continuous_on (iterated_deriv_within m f s) s :=
begin
  simp [iterated_deriv_within_eq_equiv_comp, continuous_linear_equiv.comp_continuous_on_iff,
    -coe_fn_coe_base],
  exact h.continuous_on_iterated_fderiv_within hmn hs
end

/-- On a set with unique derivatives, a `C^n` function has derivatives less than `n` which are
differentiable. -/
lemma times_cont_diff_on.differentiable_on_iterated_deriv_within {n : with_top ℕ} {m : ℕ}
  (h : times_cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) < n) (hs : unique_diff_on 𝕜 s) :
  differentiable_on 𝕜 (iterated_deriv_within m f s) s :=
begin
  simp [iterated_deriv_within_eq_equiv_comp, continuous_linear_equiv.comp_differentiable_on_iff,
    -coe_fn_coe_base],
  exact h.differentiable_on_iterated_fderiv_within hmn hs
end

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative on sets with unique derivatives. -/
lemma times_cont_diff_on_iff_continuous_on_differentiable_on_deriv {n : with_top ℕ}
  (hs : unique_diff_on 𝕜 s) :
  times_cont_diff_on 𝕜 n f s ↔
  (∀m:ℕ, (m : with_top ℕ) ≤ n → continuous_on (iterated_deriv_within m f s) s)
  ∧ (∀m:ℕ, (m : with_top ℕ) < n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) :=
by simp only [times_cont_diff_on_iff_continuous_on_differentiable_on hs,
  iterated_fderiv_within_eq_equiv_comp, continuous_linear_equiv.comp_continuous_on_iff,
  continuous_linear_equiv.comp_differentiable_on_iff]

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
differentiating the `n`-th iterated derivative. -/
lemma iterated_deriv_within_succ {x : 𝕜} (hxs : unique_diff_within_at 𝕜 s x) :
  iterated_deriv_within (n + 1) f s x = deriv_within (iterated_deriv_within n f s) s x :=
begin
  rw [iterated_deriv_within_eq_iterated_fderiv_within, iterated_fderiv_within_succ_apply_left,
      iterated_fderiv_within_eq_equiv_comp, continuous_linear_equiv.comp_fderiv_within _ hxs,
      deriv_within],
  change ((continuous_multilinear_map.mk_pi_field 𝕜 (fin n)
    ((fderiv_within 𝕜 (iterated_deriv_within n f s) s x : 𝕜 → F) 1)) : (fin n → 𝕜 ) → F)
    (λ (i : fin n), 1)
    = (fderiv_within 𝕜 (iterated_deriv_within n f s) s x : 𝕜 → F) 1,
  simp
end

/-- The `n`-th iterated derivative within a set with unique derivatives can be obtained by
iterating `n` times the differentiation operation. -/
lemma iterated_deriv_within_eq_iterate {x : 𝕜} (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) :
  iterated_deriv_within n f s x = ((λ (g : 𝕜 → F), deriv_within g s)^[n]) f x :=
begin
  induction n with n IH generalizing x,
  { simp },
  { rw [iterated_deriv_within_succ (hs x hx), function.iterate_succ'],
    exact deriv_within_congr (hs x hx) (λ y hy, IH hy) (IH hx) }
end

/-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by
taking the `n`-th derivative of the derivative. -/
lemma iterated_deriv_within_succ' {x : 𝕜} (hxs : unique_diff_on 𝕜 s) (hx : x ∈ s) :
  iterated_deriv_within (n + 1) f s x = (iterated_deriv_within n (deriv_within f s) s) x :=
by { rw [iterated_deriv_within_eq_iterate hxs hx, iterated_deriv_within_eq_iterate hxs hx], refl }

/-! ### Properties of the iterated derivative on the whole space -/

lemma iterated_deriv_eq_iterated_fderiv :
  iterated_deriv n f x
  = (iterated_fderiv 𝕜 n f x : ((fin n) → 𝕜) → F) (λ(i : fin n), 1) := rfl

/-- Write the iterated derivative as the composition of a continuous linear equiv and the iterated
Fréchet derivative -/
lemma iterated_deriv_eq_equiv_comp :
  iterated_deriv n f
  = (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F).symm ∘ (iterated_fderiv 𝕜 n f) :=
by { ext x, refl }

/-- Write the iterated Fréchet derivative as the composition of a continuous linear equiv and the
iterated derivative. -/
lemma iterated_fderiv_eq_equiv_comp :
  iterated_fderiv 𝕜 n f
  = (continuous_multilinear_map.pi_field_equiv 𝕜 (fin n) F) ∘ (iterated_deriv n f) :=
begin
  rw [iterated_deriv_eq_equiv_comp, ← function.comp.assoc,
      continuous_linear_equiv.self_comp_symm],
  refl
end

/-- The `n`-th Fréchet derivative applied to a vector `(m 0, ..., m (n-1))` is the derivative
multiplied by the product of the `m i`s. -/
lemma iterated_fderiv_apply_eq_iterated_deriv_mul_prod {m : (fin n) → 𝕜} :
  (iterated_fderiv 𝕜 n f x : ((fin n) → 𝕜) → F) m = (∏ i, m i) • iterated_deriv n f x :=
by { rw [iterated_deriv_eq_iterated_fderiv, ← continuous_multilinear_map.map_smul_univ], simp }

@[simp] lemma iterated_deriv_zero :
  iterated_deriv 0 f = f :=
by { ext x, simp [iterated_deriv] }

@[simp] lemma iterated_deriv_one :
  iterated_deriv 1 f = deriv f :=
by { ext x, simp [iterated_deriv], refl }

/-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be
reformulated in terms of the one-dimensional derivative. -/
lemma times_cont_diff_iff_iterated_deriv {n : with_top ℕ} :
  times_cont_diff 𝕜 n f ↔
(∀m:ℕ, (m : with_top ℕ) ≤ n → continuous (iterated_deriv m f))
∧ (∀m:ℕ, (m : with_top ℕ) < n → differentiable 𝕜 (iterated_deriv m f)) :=
by simp only [times_cont_diff_iff_continuous_differentiable, iterated_fderiv_eq_equiv_comp,
  continuous_linear_equiv.comp_continuous_iff,
  continuous_linear_equiv.comp_differentiable_iff]

/-- To check that a function is `n` times continuously differentiable, it suffices to check that its
first `n` derivatives are differentiable. This is slightly too strong as the condition we
require on the `n`-th derivative is differentiability instead of continuity, but it has the
advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal).
-/
lemma times_cont_diff_of_differentiable_iterated_deriv {n : with_top ℕ}
  (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable 𝕜 (iterated_deriv m f)) :
  times_cont_diff 𝕜 n f :=
times_cont_diff_iff_iterated_deriv.2
  ⟨λ m hm, (h m hm).continuous, λ m hm, (h m (le_of_lt hm))⟩

lemma times_cont_diff.continuous_iterated_deriv {n : with_top ℕ} (m : ℕ)
  (h : times_cont_diff 𝕜 n f) (hmn : (m : with_top ℕ) ≤ n) :
  continuous (iterated_deriv m f) :=
(times_cont_diff_iff_iterated_deriv.1 h).1 m hmn

lemma times_cont_diff.differentiable_iterated_deriv {n : with_top ℕ} (m : ℕ)
  (h : times_cont_diff 𝕜 n f) (hmn : (m : with_top ℕ) < n) :
  differentiable 𝕜 (iterated_deriv m f) :=
(times_cont_diff_iff_iterated_deriv.1 h).2 m hmn

/-- The `n+1`-th iterated derivative can be obtained by differentiating the `n`-th
iterated derivative. -/
lemma iterated_deriv_succ : iterated_deriv (n + 1) f = deriv (iterated_deriv n f) :=
begin
  ext x,
  rw [← iterated_deriv_within_univ, ← iterated_deriv_within_univ, ← deriv_within_univ],
  exact iterated_deriv_within_succ unique_diff_within_at_univ,
end

/-- The `n`-th iterated derivative can be obtained by iterating `n` times the
differentiation operation. -/
lemma iterated_deriv_eq_iterate : iterated_deriv n f = (deriv^[n]) f :=
begin
  ext x,
  rw [← iterated_deriv_within_univ],
  convert iterated_deriv_within_eq_iterate unique_diff_on_univ (mem_univ x),
  simp [deriv_within_univ]
end

/-- The `n+1`-th iterated derivative can be obtained by taking the `n`-th derivative of the
derivative. -/
lemma iterated_deriv_succ' : iterated_deriv (n + 1) f = iterated_deriv n (deriv f) :=
by { rw [iterated_deriv_eq_iterate, iterated_deriv_eq_iterate], refl }