import analysis.special_functions.pow
import analysis.special_functions.log.basic
import analysis.specific_limits.basic
import category_theory.Fintype
import analysis.normed_space.basic

import laurent_measures.bounded
import pseudo_normed_group.basic
import pseudo_normed_group.category

universe u

noncomputable theory
open_locale big_operators nnreal classical

/-
structure c_measures (r : ℝ≥0) (c : ℝ≥0) (S : Fintype) :=
(to_fun     : S → ℤ → ℤ)
(summable   : ∀ s, summable (λ n, (∥ to_fun s n ∥₊ * r ^ n)))
(bdd        : ∀ s, tsum (λ n, (∥ to_fun s n ∥₊ * r ^ n)) ≤ c)
-/

/-- A term of type `laurent_measures r S` is, for each `s : S`, a function `φ : ℤ → ℤ`
  (typically thought of as a power series `∑ φ(n)Tⁿ`) such that `∑ |φ(n)|rⁿ` converges.
  Note that if `0<r<1` then the support of φ can only contain finitely many negative integers.  -/
structure laurent_measures (r : ℝ≥0) (S : Fintype) :=
(to_fun    : S → ℤ → ℤ)
(summable' : ∀ s, summable (λ n, ∥to_fun s n∥₊ * r ^ n))

variables {r : ℝ≥0} {S S' : Fintype.{u}}

local notation `ℒ` := laurent_measures r

namespace laurent_measures

instance : has_coe_to_fun (ℒ S) (λ F, S → ℤ → ℤ) :=
⟨λ F, F.to_fun⟩

@[simp] lemma coe_mk (f : S → ℤ → ℤ) (hf) (s : S) (n : ℤ) :
  (@laurent_measures.mk r S f hf) s n = f s n := rfl

@[ext]
lemma ext (F G : ℒ S) : (F : S → ℤ → ℤ) = G → F = G :=
by { intros h, cases F, cases G, simpa }

lemma ext_iff (F G : ℒ S) : F = G ↔ ∀ s n, F s n = G s n :=
⟨λ h, by intros; rw h, λ h, laurent_measures.ext F G $ by ext; apply h⟩

protected lemma nnreal_summable (F : ℒ S) (s : S) : summable (λ n, ∥F s n∥₊ * r ^ n) :=
F.2 _

protected lemma summable (F : ℒ S) (s : S) : summable (λ n, ∥F s n∥ * r ^ n) :=
begin
  simpa only [← nnreal.summable_coe, nnreal.coe_mul, coe_nnnorm, nnreal.coe_zpow]
    using F.nnreal_summable s
end

-- Move me
lemma nonneg_of_norm_mul_zpow (k n : ℤ) (r : ℝ≥0) : 0 ≤ ∥ k ∥ * (r : ℝ)^n :=
mul_nonneg (norm_nonneg _) (zpow_nonneg (nnreal.coe_nonneg _) _)

def map (f : S ⟶ S') : ℒ S → ℒ S' := λ F,
{ to_fun := λ s' k, ∑ s in finset.univ.filter (λ t, f t = s'), F s k,
  summable' := begin
    intros s',
    have : ∀ n : ℤ, ∥∑ s in finset.univ.filter (λ t, f t = s'), F s n∥₊ * r^n ≤
      ∑ s in finset.univ.filter (λ t, f t = s'), ∥F s n∥₊ * r^n := λ n,
    calc ∥∑ s in finset.univ.filter (λ t, f t = s'), F s n∥₊ * r^n ≤
      (∑ s in finset.univ.filter (λ t, f t = s'), ∥F s n∥₊) * r^n :
        mul_le_mul' (nnnorm_sum_le _ _) le_rfl
      ... = _ : by rw finset.sum_mul,
    exact nnreal.summable_of_le this (summable_sum $ λ (s : S) _, F.nnreal_summable s),
  end }

@[simp] lemma map_apply (f : S ⟶ S') (F : ℒ S) (s' : S') (k : ℤ) :
  map f F s' k = ∑ s in finset.univ.filter (λ t, f t = s'), F s k := rfl

@[simp] lemma map_id : (map (𝟙 S) : ℒ S → ℒ S) = id :=
begin
  ext F s k,
  simp only [map_apply, Fintype.id_apply, id.def, finset.sum_filter,
    finset.sum_ite_eq', finset.mem_univ, if_true],
end

@[simp] lemma map_comp {S'' : Fintype.{u}} (f : S ⟶ S') (g : S' ⟶ S'') :
  (map (f ≫ g) : ℒ S → ℒ S'') = map g ∘ map f :=
begin
  ext F s k,
  simp only [function.comp_app, map_apply, finset.sum_congr],
  rw ← finset.sum_bUnion,
  { apply finset.sum_congr,
    { change finset.univ.filter (λ t, g (f t) = s) = _,
      ext i,
      split;
      { intro hi, simpa only [finset.mem_bUnion, finset.mem_filter, finset.mem_univ, true_and,
          exists_prop, exists_eq_right'] using hi } },
    { intros, refl } },
  { intros i hi j hj h k hk,
    simp only [finset.inf_eq_inter, finset.mem_inter, finset.mem_filter, finset.mem_univ, true_and,
      finset.coe_filter, finset.coe_univ, set.sep_univ, set.mem_set_of_eq] at hi hj hk,
    refine h _,
    rw [← hk.1, ← hk.2] }
end

def add : ℒ S → ℒ S → ℒ S := λ F G,
{ to_fun := F + G,
  summable' := λ s, begin
    refine nnreal.summable_of_le _ ((F.nnreal_summable s).add (G.nnreal_summable s)),
    intros n,
    rw ← add_mul,
    exact mul_le_mul' (nnnorm_add_le _ _) le_rfl,
  end }

instance : has_add (ℒ S) := ⟨add⟩

@[simp]
lemma add_apply (F G : ℒ S) (s : S) (n : ℤ) : (F + G) s n = F s n + G s n := rfl

def zero : ℒ S :=
{ to_fun := 0,
  summable' := λ s, by simp [summable_zero] }

instance : has_zero (ℒ S) := ⟨zero⟩

@[simp] lemma zero_apply (s : S) (n : ℤ) : (0 : ℒ S) s n = 0 := rfl

def neg : ℒ S → ℒ S := λ F,
{ to_fun := - F,
  summable' := λ s, by simp [F.nnreal_summable] }

instance : has_neg (ℒ S) := ⟨neg⟩

@[simp] lemma neg_apply (F : ℒ S) (s : S) (n : ℤ) : (-F) s n = - (F s n) := rfl

def sub : ℒ S → ℒ S → ℒ S := λ F G,
{ to_fun := F - G,
  summable' := (add F (neg G)).nnreal_summable }

instance : has_sub (ℒ S) := ⟨sub⟩

@[simp] lemma sub_apply (F G : ℒ S) (s : S) (n : ℤ) : (F - G) s n = F s n - G s n := rfl

example (a m : ℤ) : (-a)*m=a*(-m) := neg_mul_comm a m

-- move me
instance : has_continuous_smul ℕ ℝ≥0 :=
{ continuous_smul := begin
    let f : ℕ × ℝ≥0 → ℝ≥0 × ℝ≥0 := prod.map coe id,
    have hf : continuous f := continuous.prod_map continuous_bot continuous_id,
    simpa only [nsmul_eq_mul] using continuous_mul.comp hf,
end }

-- move me
@[simp] lemma _root_.int.norm_mul (m n : ℤ) : ∥m * n∥ = ∥m∥ * ∥n∥ :=
by simp only [int.norm_eq_abs, int.cast_mul, abs_mul]

-- move me
@[simp] lemma _root_.int.nnnorm_mul (m n : ℤ) : ∥m * n∥₊ = ∥m∥₊ * ∥n∥₊ :=
by ext; simp only [coe_nnnorm, int.norm_mul, nonneg.coe_mul]

-- move me
@[simp] lemma _root_.nat.norm_coe_int (n : ℕ) : ∥(n : ℤ)∥ = n :=
by simp only [int.norm_eq_abs, int.cast_coe_nat, nat.abs_cast]

-- move me
@[simp] lemma _root_.nat.nnnorm_coe_int (n : ℕ) : ∥(n : ℤ)∥₊ = n :=
by ext; simp only [coe_nnnorm, nat.norm_coe_int, nnreal.coe_nat_cast]

instance : add_comm_monoid (ℒ S) :=
{ add_assoc := λ a b c, by { ext, simp only [add_assoc, add_apply] },
  add_comm := λ F G, by { ext, simp only [add_comm, add_apply] },
  zero_add := λ a, by { ext, simp only [zero_add, add_apply, zero_apply] },
  add_zero := λ a, by { ext, simp only [add_zero, add_apply, zero_apply] },
  nsmul := λ n F,
  { to_fun := λ s k, n • (F s k),
    summable' := λ s, begin
      -- aahrg, why is `n` an implicit variable here???
      have := @summable.const_smul _ _ _ _ _ _ _ _ _ n (F.nnreal_summable s),
      simpa only [nsmul_eq_mul, int.nnnorm_mul, nat.nnnorm_coe_int, mul_assoc],
    end },
  nsmul_zero' := λ F, by { ext, refl },
  nsmul_succ' := λ n F, by { ext, refl },
  ..(infer_instance : has_add _),
  ..(infer_instance : has_zero _) }

instance : add_comm_group (ℒ S) :=
{ neg := neg,
  sub := sub,
  sub_eq_add_neg := λ F G, by { ext, refl },
  zsmul := λ n F,
  { to_fun := λ s m, n • (F s m),
    summable' := λ s, begin
      -- aahrg, why is `n.nat_abs` an implicit variable here???
      have := @summable.const_smul _ _ _ _ _ _ _ _ _ n.nat_abs (F.nnreal_summable s),
      simpa only [nsmul_eq_mul, nnreal.coe_nat_abs, algebra.id.smul_eq_mul,
        int.nnnorm_mul, mul_assoc],
    end },
  zsmul_zero' := λ F, by { ext, simp only [algebra.id.smul_eq_mul, zero_mul, coe_mk, zero_apply], },
  zsmul_succ' := λ n F, by { ext, simp only [add_apply, int.coe_nat_succ, int.of_nat_eq_coe,
    zsmul_eq_smul, smul_eq_mul, add_mul, add_comm, one_mul, coe_mk], },
  zsmul_neg' := λ n F, by { ext, rw neg_apply, simp only [neg_apply, int.coe_nat_succ, int.of_nat_eq_coe,
    int.neg_succ_of_nat_coe, add_comm, zsmul_eq_smul, smul_eq_mul], dsimp, ring_nf},
  add_left_neg := λ F, by { ext, simp only [zero_apply, add_apply, neg_apply, add_left_neg], },
  add_comm := λ a b, by { ext, dsimp, rw add_comm },
  ..(infer_instance : add_comm_monoid _),
  ..(infer_instance : has_neg _),
  ..(infer_instance : has_sub _) }.

instance : has_norm (ℒ S) :=
⟨λ F, ∑ s, ∑' n, ∥F s n∥ * (r : ℝ) ^ n⟩

lemma norm_def (F : ℒ S) : ∥F∥ = ∑ s, ∑' n, ∥F s n∥ * (r : ℝ)^n := rfl

instance : has_nnnorm (ℒ S) :=
⟨λ F, ∑ s, ∑' n, ∥F s n∥₊ * r ^ n⟩

lemma nnnorm_def (F : ℒ S) : ∥F∥₊ = ∑ s, ∑' n, ∥F s n∥₊ * r^n := rfl

@[simp] lemma coe_nnnorm (F : ℒ S) : (∥F∥₊ : ℝ) = ∥F∥ :=
by simp only [nnnorm_def, norm_def, nnreal.coe_sum, nnreal.coe_tsum,
  nonneg.coe_mul, coe_nnnorm, nnreal.coe_zpow]

@[simp] lemma laurent_measures.norm_nonneg (F : ℒ S) : 0 ≤ ∥F∥ :=
by rw [← coe_nnnorm]; exact ∥F∥₊.coe_nonneg

@[simp] lemma nnnorm_neg (F : ℒ S) : ∥-F∥₊ = ∥F∥₊ :=
by simp only [nnnorm_def, neg_apply, nnnorm_neg]

lemma nnnorm_add (F G : ℒ S) : ∥F + G∥₊ ≤ ∥F∥₊ + ∥G∥₊ :=
begin
  simp only [nnnorm_def, ← finset.sum_add_distrib],
  apply finset.sum_le_sum,
  rintro s -,
  rw ← tsum_add (F.nnreal_summable _) (G.nnreal_summable _),
  refine tsum_le_tsum _ ((F + G).nnreal_summable _)
    ((F.nnreal_summable s).add (G.nnreal_summable s)),
  intro b,
  simp [← add_mul],
  refine mul_le_mul' (nnnorm_add_le _ _) le_rfl
end

lemma norm_add (F G : ℒ S) : ∥F + G∥ ≤ ∥F∥ + ∥G∥ :=
by simpa only [← coe_nnnorm, ← nnreal.coe_add, nnreal.coe_le_coe] using nnnorm_add F G

@[simp] lemma nsmul_apply (k : ℕ) (F : ℒ S) (s : S) (n : ℤ) : (k • F) s n = k • (F s n) := rfl

@[simp] lemma zsmul_apply (k : ℤ) (F : ℒ S) (s : S) (n : ℤ) : (k • F) s n = k • (F s n) := rfl

section
open finset

lemma map_bound (f : S ⟶ S') (F : ℒ S) : ∥map f F∥₊ ≤ ∥F∥₊ := calc
∥map f F∥₊ = ∑ s', ∑' n, ∥∑ s in univ.filter (λ t, f t = s'), F s n∥₊ * _ : rfl
... ≤ ∑ s', ∑' n, ∑ s in univ.filter (λ t, f t = s'), ∥F s n∥₊ * r^n : begin
  apply sum_le_sum,
  rintros s' -,
  have h1 : summable (λ n : ℤ, ∑ (s : S.α) in univ.filter (λ t, f t = s'), ∥F s n∥₊ * r^n) :=
    summable_sum (λ s _, F.nnreal_summable s),
  have h2 : ∀ b : ℤ,
    ∥∑ (s : S.α) in univ.filter (λ t, f t = s'), F s b∥₊ * r ^ b ≤
      ∑ (s : S.α) in univ.filter (λ t, f t = s'), ∥F s b∥₊ * r ^ b,
  { intros b, rw ← sum_mul, exact mul_le_mul' (nnnorm_sum_le _ _) le_rfl },
  apply tsum_le_tsum h2 (nnreal.summable_of_le h2 h1) h1,
end
... = ∑ s', ∑ s in univ.filter (λ t, f t = s'), ∑' n, ∥F s n∥₊ * r^n :
  sum_congr rfl (λ s' _, tsum_sum $ λ s _, F.nnreal_summable _)
... = _ : begin
  rw [← sum_bUnion],
  refine sum_congr _ _,
  { ext s, simp only [mem_bUnion, mem_univ, mem_filter, true_and, exists_true_left, exists_eq'] },
  { intros, refl },
  { rintro x - y - h i hi,
    apply h,
    simp only [inf_eq_inter, mem_inter, mem_filter, mem_univ, true_and] at hi,
    rw [← hi.1, ← hi.2] }
end

end

lemma map_bound' (f : S ⟶ S') (F : ℒ S) : ∥map f F∥ ≤ ∥F∥ :=
by simpa only [← coe_nnnorm, ← nnreal.coe_add, nnreal.coe_le_coe] using map_bound f F

/-
lemma exists_c (F : ℒ S) : ∃ (c : ℝ≥0),
  ∀ s : S, ∑' n, ∥ F s n ∥ * r ^ n ≤ c :=
begin
  use ∑ s, ∑' n, ∥ F s n ∥ * r ^ n,
  { apply finset.sum_nonneg,
    rintros s -,
    apply tsum_nonneg,
    intros n,
    refine mul_nonneg (norm_nonneg _) (zpow_nonneg _ _),
    exact nnreal.coe_nonneg r, },
  { admit },
end
-/

/-- This lemma puts bounds on where `F s n` can be nonzero. -/
lemma eq_zero_of_filtration (F : ℒ S) (c : ℝ≥0) :
  ∥F∥₊ ≤ c → ∀ (s : S) (n : ℤ), c < r^n → F s n = 0 :=
begin
  intros hF s n h,
  suffices : ∥F s n∥₊ < 1,
  { change abs (F s n : ℝ) < 1 at this,
    norm_cast at this,
    rwa ← int.abs_lt_one_iff },
  have : ∥F s n∥₊ * r ^ n ≤ ∑' k, ∥F s k∥₊ * r ^ k,
  { exact le_tsum (F.nnreal_summable s) _ (λ k _, zero_le'), },
  replace this := lt_of_le_of_lt (this.trans _) h,
  { have hr₁ : 0 < r^n := lt_of_le_of_lt zero_le' h,
    have hr₂ : r^n ≠ 0 := hr₁.ne',
    convert mul_lt_mul this (le_refl (r ^ n)⁻¹) _ hr₁.le,
    { exact (mul_inv_cancel_right₀ hr₂ _).symm },
    { exact (mul_inv_cancel hr₂).symm },
    { rwa nnreal.inv_pos }, },
  { refine le_trans _ hF,
    apply @finset.single_le_sum S ℝ≥0 _ (λ s, ∑' n, ∥F s n∥₊ * r^n),
    { rintros s -, exact zero_le', },
    { exact finset.mem_univ _ } }
end

-- move me
lemma zpow_strict_anti {K : Type} [linear_ordered_field K] {x : K} (hx₀ : 0 < x) (hx₁ : x < 1) :
  strict_anti (λ n:ℤ, x ^ n) :=
begin
  intros n m H,
  rw [← inv_inv x],
  simp only [inv_zpow x⁻¹, inv_lt_inv (zpow_pos_of_pos (inv_pos.mpr hx₀) _)
    (zpow_pos_of_pos (inv_pos.mpr hx₀) _)],
  exact zpow_strict_mono (one_lt_inv hx₀ hx₁) H,
end

open real

--For every F, d F is a bound whose existence is established in `eq_zero_of_filtration`
lemma exists_bdd_filtration {S : Fintype} (hr₀ : 0 < (r : ℝ)) (hr₁ : (r : ℝ) < 1) (F : ℒ S) :
  ∃ d : ℤ, ∀ s : S, ∀ (n : ℤ), n < d → F s n = 0 :=
begin
  have h_logr : (log r) < 0 := log_neg hr₀ hr₁,
  let d := if log ∥ F ∥ ≥ 0 then ⌊ (log ∥ F ∥ / log (r : ℝ)) ⌋ - 1 else -1,
  use d,
  intros s n hn,
  have H1 := zpow_strict_anti hr₀ hr₁ hn,
  suffices H2 : ∥F∥₊ < r ^ d,
  { refine eq_zero_of_filtration F (∥F∥₊) le_rfl s n (H2.trans _),
    rw [← nnreal.coe_lt_coe, nnreal.coe_zpow, nnreal.coe_zpow],
    exact zpow_strict_anti hr₀ hr₁ hn, },
  have hd1 : 0 < -(d : ℝ),
  { rw [lt_neg, neg_zero, ← int.cast_zero, int.cast_lt],
    apply int.lt_of_le_sub_one,
    dsimp only [d],
    split_ifs,
    { rw [tsub_le_iff_right, sub_add, sub_self, sub_zero],
      exact int.floor_nonpos (div_nonpos_of_nonneg_of_nonpos h(le_of_lt h_logr)) },
    { simp only [zero_sub] } },
  have hFd1 : (log ∥ F ∥) < d * (log (r : ℝ)),
  { rw ← zsmul_eq_mul,
    rw ite_smul,
    split_ifs,
    { rw zsmul_eq_mul,
      calc (log ∥F∥)
          = (log ∥F∥/log r) * log r : (div_mul_cancel (log ∥F∥) (ne_of_lt h_logr)).symm
      ... ≤ ⌊ (log ∥F∥)/log r⌋ * log r : (mul_le_mul_right_of_neg h_logr).mpr (int.floor_le _)
      ... < (⌊ (log ∥F∥)/log r⌋ - 1) * log r : (mul_lt_mul_right_of_neg h_logr).mpr (sub_one_lt _)
      ... = ↑(⌊ (log ∥F∥)/log r⌋ - 1) * log r : by simp only [int.cast_one, int.cast_sub] },
    { rw [neg_smul, one_smul],
      rw [ge_iff_le, not_le] at h,
      apply h.trans,
      rwa [lt_neg, neg_zero] } },
  rw [← nnreal.coe_lt_coe, nnreal.coe_zpow, coe_nnnorm],
  have := (real.lt_rpow_of_log_lt (laurent_measures.norm_nonneg F) hr₀ hFd1),
  rwa [real.rpow_int_cast _ d] at this,
end

def bdd_filtration {S : Fintype} (hr₀ : 0 < (r : ℝ)) (hr₁ : (r : ℝ) < 1) (F : ℒ S) : ℤ :=
(exists_bdd_filtration hr₀ hr₁ F).some

def bdd_filtration_spec {S : Fintype} (hr₀ : 0 < (r : ℝ)) (hr₁ : (r : ℝ) < 1) (F : ℒ S) :
∀ s n, n < bdd_filtration hr₀ hr₁ F → F s n = 0 := (exists_bdd_filtration hr₀ hr₁ F).some_spec

section profinite_structure

@[simps] def truncate {c : ℝ≥0} (A : finset ℤ) :
  { F : ℒ S | ∥F∥₊ ≤ c } → laurent_measures_bdd r S A c := λ F,
{ to_fun := λ s i, F s i,
  bound' := begin
    refine (finset.sum_le_sum $ λ s _, _).trans F.2,
    convert sum_le_tsum A _ ((F : ℒ S).nnreal_summable s) using 1,
    { conv_rhs { rw ← finset.sum_attach }, refl },
    { intros b hb, exact zero_le', },
  end }

lemma eq_iff_truncate_eq (c : ℝ≥0) (F G : {F : ℒ S | ∥F∥₊ ≤ c}) :
  (∀ k, truncate k F = truncate k G) → F = G :=
begin
  intros h,
  ext s i,
  specialize h {i},
  apply_fun (λ e, e s ⟨i, by simp⟩) at h,
  exact h,
end

def finset_map {A B : finset ℤ} (h : B ≤ A) : B → A :=
λ i, ⟨i, h i.2⟩

def transition {c : ℝ≥0} {A B : finset ℤ} (h : B ≤ A) :
  laurent_measures_bdd r S A c → laurent_measures_bdd r S B c := λ F,
⟨λ s i, F s (finset_map h i), begin
  refine (finset.sum_le_sum $ λ s _, _).trans F.2,
  have : ∑ i : B, ∥F s (finset_map h i)∥₊ * r^(i : ℤ) =
    ∑ i in finset.univ.image (finset_map h), ∥F s i∥₊ * r^(i : ℤ),
  { rw finset.sum_image,
    { refl },
    { rintros i - j - hh,
      apply subtype.ext,
      apply_fun (λ e, e.val) at hh,
      exact hh } },
  rw this,
  refine finset.sum_le_sum_of_subset_of_nonneg (finset.subset_univ _) (λ _ _ _, zero_le'),
end⟩

def mk_seq {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c) :
  S → ℤ → ℤ := λ s i, F {i} s ⟨i, by simp⟩

lemma mk_seq_compat {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c)
  (compat : ∀ (A B : finset ℤ) (h : B ≤ A), transition h (F _) = F _) (s : S)
  (A : finset ℤ) (i : A) : mk_seq F s i = F A s i :=
begin
  have : ({i} : finset ℤ) ≤ A, { simp },
  specialize compat _ _ this,
  dsimp [mk_seq],
  rw ← compat,
  change (F A) s _ = _,
  congr,
  ext,
  refl,
end

lemma mk_seq_compat_summable {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c)
  (compat : ∀ (A B : finset ℤ) (h : B ≤ A), transition h (F _) = F _) (s : S) :
  summable (λ k : ℤ, ∥mk_seq F s k∥ * (r:ℝ)^k) :=
begin
  apply summable_of_sum_le,
  { intro k,
    dsimp,
    refine mul_nonneg (norm_nonneg _) (zpow_nonneg (nnreal.coe_nonneg _) _) },
  { intros A,
    rw ← finset.sum_attach,
    refine le_trans _ (F A).bound,
    simp_rw mk_seq_compat _ compat,
    simp only [laurent_measures_bdd.nnnorm_def, finset.univ_eq_attach, nnreal.coe_sum,
      nnreal.coe_mul, nnreal.coe_zpow],
    apply @finset.single_le_sum S ℝ _ (λ s, ∑ (i : A), ∥ F A s i ∥ * (r : ℝ)^(i : ℤ)),
    swap, { simp },
    rintro s -,
    apply finset.sum_nonneg,
    rintros a -,
    refine mul_nonneg (norm_nonneg _) (zpow_nonneg (nnreal.coe_nonneg _) _) },
end

lemma mk_seq_compat_nnreal_summable {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c)
  (compat : ∀ (A B : finset ℤ) (h : B ≤ A), transition h (F _) = F _) (s : S) :
  summable (λ k : ℤ, ∥mk_seq F s k∥₊ * r^k) :=
begin
  rw ← nnreal.summable_coe,
  simpa only [nonneg.coe_mul, coe_nnnorm, nnreal.coe_zpow] using mk_seq_compat_summable F compat s
end

lemma mk_seq_compat_sum_le {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c)
  (compat : ∀ (A B : finset ℤ) (h : B ≤ A), transition h (F _) = F _)  :
  ∑ (s : S), ∑' (k : ℤ), ∥mk_seq F s k∥₊ * r^k ≤ c :=
begin
  rw ← tsum_sum,
  swap, { intros s hs, apply mk_seq_compat_nnreal_summable _ compat },
  have : ∀ A : finset ℤ,
    ∑ (b : A), ∑ (s : S), ∥F A s b∥₊ * r^(b : ℤ) ≤ c,
  { intros A,
    rw finset.sum_comm,
    exact (F A).bound },
  apply tsum_le_of_sum_le,
  { apply summable_sum,
    intros s hs,
    apply mk_seq_compat_nnreal_summable _ compat },
  intros I,
  rw finset.sum_comm,
  convert (F I).bound using 1,
  dsimp,
  apply finset.sum_congr rfl,
  rintros s -,
  rw ← finset.sum_attach,
  apply finset.sum_congr rfl,
  rintros i -,
  simp_rw [mk_seq_compat _ compat],
end

lemma exists_of_compat {c} (F : Π (A : finset ℤ), laurent_measures_bdd r S A c)
  (compat : ∀ (A B : finset ℤ) (h : B ≤ A),
    transition h (F _) = F _) :
  ∃ (G : {H : ℒ S | ∥H∥₊ ≤ c }), ∀ (k : finset ℤ), truncate k G = F k :=
begin
  let G : ℒ S := ⟨mk_seq F, mk_seq_compat_nnreal_summable _ compat⟩,
  use G,
  { apply mk_seq_compat_sum_le _ compat },
  { intros k,
    ext s i,
    change F _ _ _ = _,
    have := compat k {i} (by simp),
    apply_fun (λ e, e s ⟨i, by simp⟩) at this,
    erw ← this,
    change F k _ _ = F k _ _,
    congr,
    ext, refl }
end

variables (r S)
open category_theory
/-- `laurent_measures_bdd_functor r S c` is the contravariant functor sending `T : finset ℤ` to
  the finite type `laurent_measures_bdd r S T c`. Morphisms are given by throwing away
  coefficients. -/
def laurent_measures_bdd_functor (c : ℝ≥0) [fact (0 < r)] :
  (as_small (finset ℤ))ᵒᵖ ⥤ Fintype :=
{ obj := λ A, Fintype.of $ laurent_measures_bdd r S (ulift.down A.unop) c,
  map := λ A B f, transition (le_of_hom $ ulift.down f.unop) }.

/-- The `equiv` between Laurent measures with norm at most `c` and the projective limit
over `T : finset ℤ` of the finite types `laurent_measures_bdd r S T c`. -/
def laurent_measures_bdd_equiv (c : ℝ≥0) [fact (0 < r)] : { F : ℒ S | ∥F∥₊ ≤ c } ≃
  (Profinite.limit_cone (laurent_measures_bdd_functor r S c ⋙ Fintype.to_Profinite)).X :=
equiv.of_bijective (λ F, ⟨λ A, truncate (ulift.down A.unop) F, λ A B f, by { ext, refl }⟩)
begin
  split,
  { intros F G h,
    apply eq_iff_truncate_eq,
    intros k,
    dsimp at h,
    apply_fun (λ e, e.1 (opposite.op ⟨k⟩)) at h,
    exact h },
  { rintros ⟨F, hF⟩,
    dsimp at F hF,
    obtain ⟨G,hG⟩ := exists_of_compat (λ A, F (opposite.op ⟨A⟩)) _,
    { use G,
      ext : 2,
      dsimp,
      have := hG (ulift.down x.unop),
      convert this,
      rw ← x.op_unop,
      congr' 1,
      ext,
      refl },
    { intros A B h,
      let e : (opposite.op $ as_small.up.obj A) ⟶ (opposite.op $ as_small.up.obj B) :=
        quiver.hom.op (as_small.up.map (hom_of_le h)),
      exact hF e } }
end

/-- The profinite topology on the Laurent measures with norm at most `c`. -/
instance (c : ℝ≥0) [fact (0 < r)] : topological_space {F : ℒ S | ∥F∥₊ ≤ c} :=
topological_space.induced (laurent_measures_bdd_equiv r S c) infer_instance

def laurent_measures_bdd_homeo (c : ℝ≥0) [fact (0 < r)] : { F : ℒ S | ∥F∥₊ ≤ c } ≃ₜ
  (Profinite.limit_cone (laurent_measures_bdd_functor r S c ⋙ Fintype.to_Profinite)).X :=
{ continuous_to_fun := continuous_induced_dom,
  continuous_inv_fun := begin
    have : inducing (laurent_measures_bdd_equiv r S c) := ⟨rfl⟩,
    rw this.continuous_iff,
    dsimp,
    simp only [equiv.self_comp_symm],
    exact continuous_id,
  end,
  ..(laurent_measures_bdd_equiv _ _ _) }

instance (c : ℝ≥0) [fact (0 < r)] : t2_space { F : ℒ S | ∥F∥₊ ≤ c } :=
(laurent_measures_bdd_homeo r S c).symm.t2_space

instance (c : ℝ≥0) [fact (0 < r)] : totally_disconnected_space { F : ℒ S | ∥F∥₊ ≤ c } :=
(laurent_measures_bdd_homeo r S c).symm.totally_disconnected_space

instance (c : ℝ≥0) [fact (0 < r)] : compact_space {F : ℒ S | ∥F∥₊ ≤ c} :=
(laurent_measures_bdd_homeo r S c).symm.compact_space

@[continuity]
lemma truncate_continuous (c : ℝ≥0) [fact (0 < r)] (A : finset ℤ) :
  continuous (truncate A : _ → laurent_measures_bdd r S _ c) :=
begin
  let g₁ :=
    (Profinite.limit_cone (laurent_measures_bdd_functor.{u} r S c ⋙ Fintype.to_Profinite)).π.app
    (opposite.op $ ulift.up A),
  let g₂ := (laurent_measures_bdd_homeo r S c),
  change continuous (g₁ ∘ g₂),
  continuity,
end

lemma continuous_iff (c : ℝ≥0) [fact (0 < r)] {α : Type*} [topological_space α]
  (f : α → { F : ℒ S | ∥F∥₊ ≤ c }) :
  continuous f ↔ ∀ (A : finset ℤ), continuous ((truncate A) ∘ f) :=
begin
  split,
  { intros hf A, continuity },
  { intros h,
    rw ← (laurent_measures_bdd_homeo r S c).comp_continuous_iff,
    apply continuous.subtype_mk,
    apply continuous_pi,
    intros A,
    apply h }
end

end profinite_structure

/-
--should this be a coercion?
def c_measures_to_oc (r : ℝ≥0) (c : ℝ≥0) (S : Type*) (hS : fintype S) :
  c_measures r c S hS → ℒ S hS := λ f, ⟨f.to_fun, f.summable⟩

lemma laurent_measures_are_c (r : ℝ≥0) (S : Type*) (hS : fintype S) (F : ℒ S hS) :
  ∃ (c : ℝ≥0) (f : c_measures r c S hS),
  c_measures_to_oc r c S hS f = F := by admit
-/

--needed?
instance : pseudo_normed_group (ℒ S) :=
{ filtration := λ c, { F | ∥F∥₊ ≤ c },
  filtration_mono := λ c₁ c₂ h F hF, by {dsimp at *, exact le_trans hF h},
  zero_mem_filtration := λ c, by simp [nnnorm_def],
  neg_mem_filtration := λ c F h, (nnnorm_neg F).le.trans h,
  add_mem_filtration := λ c₁ c₂ F₁ F₂ h₁ h₂, (nnnorm_add _ _).trans (add_le_add h₁ h₂) }

@[simp] lemma mem_filtration_iff (F : ℒ S) (c : ℝ≥0) :
  F ∈ pseudo_normed_group.filtration (ℒ S) c ↔ ∥F∥₊ ≤ c := iff.rfl

instance [fact (0 < r)] : profinitely_filtered_pseudo_normed_group (ℒ S) :=
{ continuous_add' := begin
    intros c₁ c₂,
    rw continuous_iff,
    intros A,
    let E : laurent_measures_bdd r S A c₁ × laurent_measures_bdd r S A c₂ →
      laurent_measures_bdd r S A (c₁ + c₂) := λ G, ⟨G.1 + G.2, _⟩,
    swap, {
      refine le_trans _ (add_le_add G.fst.2 G.snd.2),
      rw ← finset.sum_add_distrib,
      apply finset.sum_le_sum,
      intros i hi,
      rw ← finset.sum_add_distrib,
      apply finset.sum_le_sum,
      intros j hj,
      rw ← add_mul,
      refine mul_le_mul' (norm_add_le _ _) le_rfl, },
    have :
      (truncate A : _ → laurent_measures_bdd r S A (c₁ + c₂)) ∘ pseudo_normed_group.add' =
      E ∘ (prod.map (truncate A) (truncate A)),
    { ext, refl },
    rw this,
    apply continuous.comp,
    { exact continuous_of_discrete_topology },
    { apply continuous.prod_map,
      all_goals {apply truncate_continuous} }
  end,
  continuous_neg' := begin
    intros c,
    rw continuous_iff,
    intros A,
    let E : laurent_measures_bdd r S A c → laurent_measures_bdd r S A c :=
      λ G, ⟨- G, _⟩,
    swap, {
      convert G.2 using 1,
      apply finset.sum_congr rfl,
      intros s hs,
      apply finset.sum_congr rfl,
      intros x hx,
      congr' 1,
      simpa },
    have : (truncate A : _ → laurent_measures_bdd r S A c) ∘ pseudo_normed_group.neg' =
      E ∘ truncate A,
    { ext, refl },
    rw this,
    apply continuous.comp,
    { exact continuous_of_discrete_topology },
    { apply truncate_continuous }
  end,
  continuous_cast_le := begin
    introsI c₁ c₂ h,
    rw continuous_iff,
    intros A,
    let g : laurent_measures_bdd r S A c₁ → laurent_measures_bdd r S A c₂ :=
      λ g, ⟨g, le_trans g.2 h.out⟩,
    have : (truncate A : _ → laurent_measures_bdd r S A c₂) ∘ pseudo_normed_group.cast_le =
      g ∘ truncate A,
    { ext, refl },
    rw this,
    apply continuous.comp,
    { exact continuous_of_discrete_topology },
    { apply truncate_continuous }
  end,
  ..(infer_instance : (pseudo_normed_group (ℒ S))) }
.

/-- The additive group homomorphism on Laurent measures induced by division by `T^k` on `ℤ((T))ᵣ` -/
@[simps] def shift_add_monoid_hom [hr : fact (0 < r)] (k : ℤ) : ℒ S →+ ℒ S :=
add_monoid_hom.mk' (λ F,
{ to_fun := λ s n, F s (n+k),
  summable' := λ s, begin
    convert (nnreal.summable_comp_injective
      (F.nnreal_summable s) (add_left_injective (k:ℤ))).mul_right (r ^ -k),
    ext n,
    simp only [function.comp, ← zpow_add₀ hr.out.ne', mul_assoc, add_neg_cancel_right],
  end })
(λ F G, by { ext, refl })
.

-- move me
@[simp, to_additive] lemma _root_.finset.prod_attach' {α M : Type*} [comm_monoid M]
  (s : finset α) (f : s → M) :
  ∏ a in s.attach, f a = ∏ a in s, if h : a ∈ s then f ⟨a, h⟩ else 1 :=
begin
  rw [eq_comm, ← finset.prod_attach, finset.prod_congr rfl],
  intros, simp only [finset.coe_mem, finset.mk_coe, dite_eq_ite, if_true],
end

@[simps]
def shift [hr : fact (0 < r)] (k : ℤ) : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) :=
comphaus_filtered_pseudo_normed_group_hom.mk_of_bound (shift_add_monoid_hom k) (r ^ -k)
begin
  abstract shift_spec {
  intro c,
  have H : _ := _,
  refine ⟨H, _⟩,
  { rw continuous_iff,
    intro A,
    let B : finset ℤ := A.map (equiv.to_embedding (equiv.add_left (k:ℤ))),
    let g : laurent_measures_bdd r S B c → laurent_measures_bdd r S A (r ^ -k * c) := λ F,
    { to_fun := λ s a, F s ⟨a+k, _⟩,
      bound' := _, },
    { suffices : truncate A ∘ _ = g ∘ truncate B,
      { rw this, exact continuous_of_discrete_topology.comp (truncate_continuous r S _ B) },
      ext F s a, refl },
    { simp only [finset.mem_map_equiv, equiv.add_left_symm, neg_neg, equiv.coe_add_left,
        neg_add_cancel_comm_assoc, finset.coe_mem], },
    { refine le_trans _ (mul_le_mul' le_rfl F.bound),
      rw [laurent_measures_bdd.nnnorm_def, mul_comm, finset.sum_mul],
      refine finset.sum_le_sum (λ s hs, _),
      simp only [B, finset.univ_eq_attach],
      erw [finset.sum_mul, finset.sum_attach', finset.sum_attach', finset.sum_map],
      refine finset.sum_le_sum (λ n hn, _),
      simp only [finset.mem_map_equiv, equiv.add_left_symm, equiv.coe_add_left, subtype.coe_mk,
        equiv.to_embedding_apply, neg_add_cancel_left],
      simp only [add_comm k, mul_assoc, ← zpow_add₀ hr.out.ne', add_neg_cancel_right], } },
  { intros F hF,
    rw mul_comm,
    refine le_trans _ (mul_le_mul' hF le_rfl),
    simp only [nnnorm_def, finset.sum_mul],
    refine finset.sum_le_sum (λ s _, le_of_eq _),
    transitivity ∑' n, ∥F s n∥₊ * r^n * (r ^ -k),
    { refine ((equiv.add_left (-k:ℤ)).tsum_eq _).symm.trans _,
      simp only [equiv.coe_add_left, shift_add_monoid_hom_apply_to_fun, neg_add_cancel_comm,
        zpow_add₀ hr.out.ne', zpow_neg_one, mul_comm (r ^ -k), mul_assoc], },
    ext,
    simp only [nonneg.coe_mul, nnreal.coe_tsum, coe_nnnorm, nnreal.coe_zpow, tsum_mul_right], } }
end
.

instance [fact (0 < r)] :
  profinitely_filtered_pseudo_normed_group_with_Tinv r (ℒ S) :=
{ Tinv := shift 1,
  Tinv_mem_filtration := λ c F hF, begin
    refine comphaus_filtered_pseudo_normed_group_hom.mk_of_bound_bound_by _ _ _ hF,
    intro c',
    have := @shift.shift_spec r S _ 1 c',
    rwa [zpow_neg_one] at this,
  end,
  .. (_: profinitely_filtered_pseudo_normed_group (ℒ S))}

@[simp] lemma Tinv_apply [fact (0 < r)] (F : ℒ S) :
  comphaus_filtered_pseudo_normed_group_with_Tinv.Tinv F = shift 1 F := rfl

variable {α : Type*}

open pseudo_normed_group profinitely_filtered_pseudo_normed_group
  comphaus_filtered_pseudo_normed_group

@[simps]
def map_hom [fact (0 < r)] (f : S ⟶ S') :
  comphaus_filtered_pseudo_normed_group_with_Tinv_hom r (ℒ S) (ℒ S') :=
{ to_fun := map f,
  map_zero' := by { ext, simp only [map_apply, zero_apply, finset.sum_const_zero], },
  map_add' := λ F G, by { ext s i, simp only [←finset.sum_add_distrib, map_apply, add_apply], },
  map_Tinv' := λ F, by { ext s i, simp only [map_apply, Tinv_apply, shift_to_fun_to_fun] },
  strict' := λ c F (hF : ∥F∥₊ ≤ c), (map_bound _ _).trans hF,
  continuous' := λ c, begin
    rw continuous_iff,
    intros T,
    let f₀ : (filtration (laurent_measures r S) c) → (filtration (laurent_measures r S') c) :=
      level (map f) (λ c F (hF : ∥F∥₊ ≤ c), (map_bound f F).trans hF) c,
    have : truncate T ∘ f₀ = laurent_measures_bdd.map f ∘ truncate T, { ext F s' t, refl },
    rw this,
    exact continuous_of_discrete_topology.comp (truncate_continuous r S _ T),
  end }

/--  Let `F : ℒ S` be a Laurent measure.  `laurent_measures.d` chooses a bound `d ∈ ℤ` for `F`,
such that, for all `s : S`, the sequence `F s` is zero from `d-1` and below. -/
def d [h0 : fact (0 < r)] [h1 : fact (r < 1)] (F : ℒ S) : ℤ :=
(exists_bdd_filtration h0.out h1.out F).some

lemma lt_d_eq_zero [h0 : fact (0 < r)] [h1 : fact (r < 1)] (F : ℒ S) (s : S) (n : ℤ) :
  n < F.d → F s n = 0 := (exists_bdd_filtration h0.out h1.out F).some_spec s n

lemma lt_d_eq_zero' [h0 : fact (0 < r)] [h1 : fact (r < 1)] (F : ℒ S) (s : S) (n : ℤ) :
  n < F.d → (F s n : ℝ) = 0 := by exact_mod_cast lt_d_eq_zero F s n

end laurent_measures


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
--Prove that \mathbb{R}^n is paracompact in Lean mathlib

--OUTPUT 1
theorem paracompact_real_space : paracompact_space ℝ :=
begin
  sorry,

--OUTPUT 2
theorem is_paracompact (n : ℕ) : paracompact_space (euclidean_space n) :=
begin
  --Let \mathcal{U} be an open cover of \mathbb{R}^n
  rintro ⟨U, hU⟩,
  --Since \mathbb{R}^n is second-countable, we can pick a countable subcover
  -- \mathcal{V} of \mathcal{U}
  have : countable_cover (euclidean_space n) U := countable_cover_of_second_countable_space (euclidean_space n),
  rcases this with ⟨V, hV⟩,
  --Define a function f : \mathbb{R}^n \to \mathbb{N} by f(x) = \min\{n \in \mathbb{N} \mid x \in V_n\}
  let f : euclidean_space n → ℕ := λ x, nat.find (λ n, x ∈ V n),
  --Since V is a cover, f is well-defined
  have hf : ∀ x, x ∈ ⋃ i, V i := λ x, nat.find_spec (λ n, x ∈ V n),
  --Define a function g : \mathbb{N} \to \mathcal{V} by g(n) = V_n
  let g : ℕ → set (euclidean_space n) := λ n, V n,
  --Since V is a cover, g is well-defined
  have hg : ∀ n, g n ∈ U := λ n, hV n,
  --Define a function h : \mathbb{N} \to \mathcal{U} by h(n) = U_n
  let h : ℕ → set (euclidean_space n) := λ n, U n,
  --Since U is a cover, h is well-defined
  have hh : ∀ n, h n ∈ U := λ n, hU n,
  --Define a function k : \mathbb{N} \to \mathbb{N} by k(n) = \min\{m \in \mathbb{N} \mid V_n \subseteq U_m\}
  let k : ℕ → ℕ := λ n, nat.find (λ m, V n ⊆ U m),
  --Since V is a cover, k is well-defined
  have hk : ∀ n, V n ⊆ U (k n) := λ n, nat.find_spec (λ m, V n ⊆ U m),
  --Define a function l : \mathbb{N} \to \mathbb{N} by l(n) = \min\{m \in \mathbb{N} \mid U_n \subseteq U_m\}
  let l : ℕ → ℕ := λ n, nat.find (λ m, U n ⊆ U m),
  --Since U is a cover, l is well-defined
  have hl : ∀ n, U n ⊆ U (l n) := λ n, nat.find_spec (λ m, U n ⊆ U m),
  --Define a function m : \mathbb{N} \to \mathbb{N} by m(n) = \min\{k(n), l(n)\}
  let m : ℕ → ℕ := λ n, nat.min (k n) (l n),
  --Define a function p : \mathbb{N} \to \mathcal{U} by p(n) = U_{m(n)}
  let p : ℕ → set (euclidean_space n) := λ n, U (m n),
  --Since U is a cover, p is well-defined
  have hp : ∀ n, p n ∈ U := λ n, hU (m n),
  --Define a function q : \mathbb{N} \to \mathcal{V} by q(n) = V_{m(n)}
  let q : ℕ → set (euclidean_space n) := λ n, V (m n),
  --Since V is a cover, q is well-defined
  have hq : ∀ n, q n ∈ U := λ n, hV (m n),
  --Define a function r : \mathbb{N} \to \mathbb{N} by r(n) = \min\{m \in \mathbb{N} \mid V_{m(n)} \subseteq U_n\}
  let r : ℕ → ℕ := λ n, nat.find (λ m, V (m n) ⊆ U n),
  --Since V is a cover, r is well-defined
  have hr : ∀ n, V (m n) ⊆ U (r n) := λ n, nat.find_spec (λ m, V (m n) ⊆ U n),
  --Define a function s : \mathbb{N} \to \mathbb{N} by s(n) = \min\{m \in \mathbb{N} \mid U_{m(n)} \subseteq U_n\}
  let s : ℕ → ℕ := λ n, nat.find (λ m, U (m n) ⊆ U n),
  --Since U is a cover, s is well-defined
  have hs : ∀ n, U (m n) ⊆ U (s n) := λ n, nat.find_spec (λ m, U (m n) ⊆ U n),
  --Define a function t : \mathbb{N} \to \mathbb{N} by t(n) = \min\{r(n), s(n)\}
  let t : ℕ → ℕ := λ n, nat.min (r n) (s n),
  --Define a function u : \mathbb{N} \to \mathcal{U} by u(n) = U_{t(n)}
  let u : ℕ → set (euclidean_space n) := λ n, U (t n),
  --Since U is a cover, u is well-defined
  have hu : ∀ n, u n ∈ U := λ n, hU (t n),
  --Define a function v : \mathbb{N} \to \mathcal{V} by v(n) = V_{t(n)}
  let v : ℕ → set (euclidean_space n) := λ n, V (t n),
  --Since V is a cover, v is well-defined
  have hv : ∀ n, v n ∈ U := λ n, hV (t n),
  --Define a function w : \mathbb{N} \to \mathbb{N} by w(n) = \min\{m \in \mathbb{N} \mid V_{t(n)} \subseteq U_m\}
  let w : ℕ → ℕ := λ n, nat.find (λ m, V (t n) ⊆ U m),
  --Since V is a cover, w is well-defined
  have hw : ∀ n, V (t n) ⊆ U (w n) := λ n, nat.find_spec (λ m, V (t n) ⊆ U m),
  --Define a function x : \mathbb{N} \to \mathbb{N} by x(n) = \min\{m \in \mathbb{N} \mid U_{t(n)} \subseteq U_m\}
  let x : ℕ → ℕ := λ n, nat.find (λ m, U (t n) ⊆ U m),
  --Since U is a cover, x is well-defined
  have hx : ∀ n, U (t n) ⊆ U (x n) := λ n, nat.find_spec (λ m, U (t n) ⊆ U m),
  --Define a function y : \mathbb{N} \to \mathbb{N} by y(n

--OUTPUT 3
theorem R_n_is_paracompact (n : ℕ) : paracompact_space (euclidean_space n) :=
begin
  --First we prove that it is a normal space
  apply normal_space_iff_normal_separation.mpr,
  --We prove that the space is normal by proving the separation axioms
  apply normal_separation_iff_normal_separation_of_closed_of_open.mpr,
  --We prove the separation axioms by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove the separation axioms by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving that the space is normal for any open set and any closed set
  apply normal_separation_of_open_of_closed_iff_normal_separation.mpr,
  --We prove that the space is normal for any open set and any closed set by proving


open classical

variables A B C D: Prop

example (h : ¬ A ∧ ¬ B) : ¬ (A ∨ B) :=
begin
  intro,
  cases ᾰ,
    apply h.left,
      assumption,
    apply h.right,
      assumption
end


namespace hidden
universes u v

inductive list (α : Type u)
| nil {} : list
| cons : α → list → list

namespace list
variable {α : Type}

notation h :: t := cons h t

def append (s t : list α) : list α :=
list.rec t (λ x l u, x::u) s

notation s ++ t := append s t

theorem nil_append (t : list α) : nil ++ t = t := rfl
theorem cons_append (x : α) (s t : list α) :
    x :: s ++ t = x :: (s ++ t) := rfl

notation `[` l:(foldr `,` (h t, cons h t) nil) `]` := l

section
    open nat
    #check [1, 2, 3, 4, 5]
    #check ([1,2,3,4,5] : list int)
end

-- exercise

theorem append_nil (t : list α) : t ++ nil = t :=
list.rec_on t
    (show (@nil α) ++ nil = nil, from rfl)
    (
        assume h,
        assume l,
        assume ih: l ++ nil = l,
        calc (h :: l) ++ nil = h :: (l ++ nil) : cons_append h l nil
        ... = h :: l : by rw ih
    )

theorem append_assoc (r s t : list α) : (r ++ s) ++ t = r ++ (s ++ t) :=
list.rec_on r
    (
        calc (nil ++ s) ++ t = s ++ t : by rw nil_append
        ... = nil ++ (s ++ t) : by rw nil_append
    )
    (
        assume h,
        assume l,
        assume ih: (l ++ s) ++ t = l ++ (s ++ t),
        calc (h :: l) ++ s ++ t = h :: (l ++ s) ++ t : by rw cons_append
        ... = h :: (l ++ s ++ t) : by rw cons_append
        ... = h :: (l ++ (s ++ t)) : by rw ih
        ... = (h :: l) ++ (s ++ t) : by rw cons_append
    )

def length : Π {α : Type u}, list α → ℕ :=
λ t l, list.rec_on l 0 (λ h x n, n + 1)

theorem append_length (s t : list α) : length (s ++ t) = length s + length t :=
list.rec_on s
    (
        show length (nil ++ t) = length nil + length t, from
        calc length (nil ++ t) = length t : by rw nil_append
        ... = 0 + length t : by rw zero_add
        ... = length nil + length t : rfl
    )
    (
        assume h,
        assume l,
        assume ih: length (l ++ t) = length l + length t,
        show length (h :: l ++ t) = length (h :: l) + length t, from
        calc length ((h :: l) ++ t) = length (h :: (l ++ t)) : by rw cons_append
        ... = length (l ++ t) + 1 : rfl
        ... = length l + length t + 1 : by rw ih
        ... = length l + 1 + length t : by simp
        ... = length (h :: l) + length t : by rw length
    )

def reverse (s : list α) : list α :=
list.rec_on s nil (λ h l t, t ++ [h])

example (h : α) (s : list α) : reverse (h :: s) = (reverse s) ++ [h] :=
rfl

example (t: list α) : length (reverse t) = length t :=
list.rec_on t
    (show length (reverse nil) = length nil, from rfl)
    (
        assume h,
        assume l : list α,
        assume ih : length (reverse l) = length l,
        show length (reverse (h :: l)) = length (h :: l), from
        calc length (reverse (h :: l))
            = length (reverse l ++ [h]) : rfl
        ... = length (reverse l) + length [h] : by rw append_length
        ... = length l + length [h] : by rw ih
    )

theorem reverse_append (s t : list α) : reverse (s ++ t) = reverse t ++ reverse s :=
list.rec_on s
    (
        show reverse (nil ++ t) = reverse t ++ reverse nil, from
        calc reverse (nil ++ t) = reverse t : by rw nil_append
        ... = reverse t ++ nil : by rw append_nil
        ... = reverse t ++ reverse nil : rfl
    )
    (
        assume h,
        assume l,
        assume ih : reverse (l ++ t) = reverse t ++ reverse l,
        show reverse ((h :: l) ++ t) = reverse t ++ reverse (h :: l), from
        calc reverse ((h :: l) ++ t)
            = reverse (h :: (l ++ t)) : by rw cons_append
        ... = reverse (l ++ t) ++ [h] : rfl
        ... = reverse t ++ reverse l ++ [h] : by rw ih
        ... = reverse t ++ (reverse l ++ [h]) : by rw append_assoc
        ... = reverse t ++ reverse (h :: l) : rfl
    )

example (t : list α) : reverse (reverse t) = t :=
list.rec_on t
    (show reverse (reverse nil) = nil, from rfl)
    (
        assume h,
        assume l : list α,
        assume ih : reverse (reverse l) = l,
        show reverse (reverse (h :: l)) = h :: l, from
        calc reverse (reverse (h :: l))
            = reverse (reverse l ++ [h]) : rfl
        ... = reverse [h] ++ reverse (reverse l) : by rw reverse_append
        ... = [h] ++ reverse (reverse l) : rfl
        ... = [h] ++ l : by rw ih
        ... = h :: l : by rw [append]
    )

end list

end hidden


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.rename
import Mathlib.data.equiv.fin
import Mathlib.PostPort

universes u u_1 v w x

namespace Mathlib

/-!
# Equivalences between polynomial rings

This file establishes a number of equivalences between polynomial rings,
based on equivalences between the underlying types.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

## Tags

equivalence, isomorphism, morphism, ring hom, hom

-/

namespace mv_polynomial

/-- The ring isomorphism between multivariable polynomials in no variables and the ground ring. -/
def pempty_ring_equiv (R : Type u) [comm_semiring R] : mv_polynomial pempty R ≃+* R :=
  ring_equiv.mk (eval₂ (ring_hom.id R) pempty.elim) ⇑C sorry sorry sorry sorry

/-- The algebra isomorphism between multivariable polynomials in no variables and the ground ring. -/
@[simp] theorem pempty_alg_equiv_symm_apply (R : Type u) [comm_semiring R] : ∀ (ᾰ : R), coe_fn (alg_equiv.symm (pempty_alg_equiv R)) ᾰ = coe_fn C ᾰ :=
  fun (ᾰ : R) => Eq.refl (coe_fn (alg_equiv.symm (pempty_alg_equiv R)) ᾰ)

/--
The ring isomorphism between multivariable polynomials in a single variable and
polynomials over the ground ring.
-/
@[simp] theorem punit_ring_equiv_symm_apply (R : Type u) [comm_semiring R] (p : polynomial R) : coe_fn (ring_equiv.symm (punit_ring_equiv R)) p = polynomial.eval₂ C (X PUnit.unit) p :=
  Eq.refl (coe_fn (ring_equiv.symm (punit_ring_equiv R)) p)

/-- The ring isomorphism between multivariable polynomials induced by an equivalence of the variables.  -/
@[simp] theorem ring_equiv_of_equiv_symm_apply (R : Type u) {S₁ : Type v} {S₂ : Type w} [comm_semiring R] (e : S₁ ≃ S₂) : ∀ (ᾰ : mv_polynomial S₂ R), coe_fn (ring_equiv.symm (ring_equiv_of_equiv R e)) ᾰ = coe_fn (rename ⇑(equiv.symm e)) ᾰ :=
  fun (ᾰ : mv_polynomial S₂ R) => Eq.refl (coe_fn (ring_equiv.symm (ring_equiv_of_equiv R e)) ᾰ)

/-- The algebra isomorphism between multivariable polynomials induced by an equivalence of the variables.  -/
@[simp] theorem alg_equiv_of_equiv_symm_apply (R : Type u) {S₁ : Type v} {S₂ : Type w} [comm_semiring R] (e : S₁ ≃ S₂) : ∀ (ᾰ : mv_polynomial S₂ R), coe_fn (alg_equiv.symm (alg_equiv_of_equiv R e)) ᾰ = coe_fn (rename ⇑(equiv.symm e)) ᾰ :=
  fun (ᾰ : mv_polynomial S₂ R) => Eq.refl (coe_fn (alg_equiv.symm (alg_equiv_of_equiv R e)) ᾰ)

/-- The ring isomorphism between multivariable polynomials induced by a ring isomorphism of the ground ring. -/
def ring_equiv_congr (R : Type u) {S₁ : Type v} {S₂ : Type w} [comm_semiring R] [comm_semiring S₂] (e : R ≃+* S₂) : mv_polynomial S₁ R ≃+* mv_polynomial S₁ S₂ :=
  ring_equiv.mk ⇑(map ↑e) ⇑(map ↑(ring_equiv.symm e)) sorry sorry sorry sorry

/--
The function from multivariable polynomials in a sum of two types,
to multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.

See `sum_ring_equiv` for the ring isomorphism.
-/
def sum_to_iter (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] : mv_polynomial (S₁ ⊕ S₂) R →+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
  eval₂_hom (ring_hom.comp C C) fun (bc : S₁ ⊕ S₂) => sum.rec_on bc X (⇑C ∘ X)

protected instance is_semiring_hom_sum_to_iter (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] : is_semiring_hom ⇑(sum_to_iter R S₁ S₂) :=
  eval₂.is_semiring_hom (ring_hom.comp C C) fun (n : S₁ ⊕ S₂) => (fun (bc : S₁ ⊕ S₂) => sum.rec_on bc X (⇑C ∘ X)) n

@[simp] theorem sum_to_iter_C (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (a : R) : coe_fn (sum_to_iter R S₁ S₂) (coe_fn C a) = coe_fn C (coe_fn C a) :=
  eval₂_C (ring_hom.comp C C) (fun (n : S₁ ⊕ S₂) => (fun (bc : S₁ ⊕ S₂) => sum.rec_on bc X (⇑C ∘ X)) n) a

@[simp] theorem sum_to_iter_Xl (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (b : S₁) : coe_fn (sum_to_iter R S₁ S₂) (X (sum.inl b)) = X b :=
  eval₂_X (ring_hom.comp C C) (fun (n : S₁ ⊕ S₂) => (fun (bc : S₁ ⊕ S₂) => sum.rec_on bc X (⇑C ∘ X)) n) (sum.inl b)

@[simp] theorem sum_to_iter_Xr (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (c : S₂) : coe_fn (sum_to_iter R S₁ S₂) (X (sum.inr c)) = coe_fn C (X c) :=
  eval₂_X (ring_hom.comp C C) (fun (n : S₁ ⊕ S₂) => (fun (bc : S₁ ⊕ S₂) => sum.rec_on bc X (⇑C ∘ X)) n) (sum.inr c)

/--
The function from multivariable polynomials in one type,
with coefficents in multivariable polynomials in another type,
to multivariable polynomials in the sum of the two types.

See `sum_ring_equiv` for the ring isomorphism.
-/
def iter_to_sum (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] : mv_polynomial S₁ (mv_polynomial S₂ R) →+* mv_polynomial (S₁ ⊕ S₂) R :=
  eval₂_hom (ring_hom.of (eval₂ C (X ∘ sum.inr))) (X ∘ sum.inl)

theorem iter_to_sum_C_C (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (a : R) : coe_fn (iter_to_sum R S₁ S₂) (coe_fn C (coe_fn C a)) = coe_fn C a :=
  Eq.trans (eval₂_C (ring_hom.of (eval₂ C (X ∘ sum.inr))) (fun (n : S₁) => function.comp X sum.inl n) (coe_fn C a))
    (eval₂_C C (fun (n : S₂) => function.comp X sum.inr n) a)

theorem iter_to_sum_X (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (b : S₁) : coe_fn (iter_to_sum R S₁ S₂) (X b) = X (sum.inl b) :=
  eval₂_X (ring_hom.of (eval₂ C (X ∘ sum.inr))) (fun (n : S₁) => function.comp X sum.inl n) b

theorem iter_to_sum_C_X (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] (c : S₂) : coe_fn (iter_to_sum R S₁ S₂) (coe_fn C (X c)) = X (sum.inr c) :=
  Eq.trans (eval₂_C (ring_hom.of (eval₂ C (X ∘ sum.inr))) (fun (n : S₁) => function.comp X sum.inl n) (X c))
    (eval₂_X C (fun (n : S₂) => function.comp X sum.inr n) c)

/-- A helper function for `sum_ring_equiv`. -/
@[simp] theorem mv_polynomial_equiv_mv_polynomial_apply (R : Type u) (S₁ : Type v) (S₂ : Type w) (S₃ : Type x) [comm_semiring R] [comm_semiring S₃] (f : mv_polynomial S₁ R →+* mv_polynomial S₂ S₃) (g : mv_polynomial S₂ S₃ →+* mv_polynomial S₁ R) (hfgC : ∀ (a : S₃), coe_fn f (coe_fn g (coe_fn C a)) = coe_fn C a) (hfgX : ∀ (n : S₂), coe_fn f (coe_fn g (X n)) = X n) (hgfC : ∀ (a : R), coe_fn g (coe_fn f (coe_fn C a)) = coe_fn C a) (hgfX : ∀ (n : S₁), coe_fn g (coe_fn f (X n)) = X n) : ∀ (ᾰ : mv_polynomial S₁ R), coe_fn (mv_polynomial_equiv_mv_polynomial R S₁ S₂ S₃ f g hfgC hfgX hgfC hgfX) ᾰ = coe_fn f ᾰ :=
  fun (ᾰ : mv_polynomial S₁ R) =>
    Eq.refl (coe_fn (mv_polynomial_equiv_mv_polynomial R S₁ S₂ S₃ f g hfgC hfgX hgfC hgfX) ᾰ)

/--
The ring isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sum_ring_equiv (R : Type u) (S₁ : Type v) (S₂ : Type w) [comm_semiring R] : mv_polynomial (S₁ ⊕ S₂) R ≃+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
  mv_polynomial_equiv_mv_polynomial R (S₁ ⊕ S₂) S₁ (mv_polynomial S₂ R) (sum_to_iter R S₁ S₂) (iter_to_sum R S₁ S₂) sorry
    sorry sorry sorry

/--
The ring isomorphism between multivariable polynomials in `option S₁` and
polynomials with coefficients in `mv_polynomial S₁ R`.
-/
def option_equiv_left (R : Type u) (S₁ : Type v) [comm_semiring R] : mv_polynomial (Option S₁) R ≃+* polynomial (mv_polynomial S₁ R) :=
  ring_equiv.trans (ring_equiv_of_equiv R (equiv.trans (equiv.option_equiv_sum_punit S₁) (equiv.sum_comm S₁ PUnit)))
    (ring_equiv.trans (sum_ring_equiv R PUnit S₁) (punit_ring_equiv (mv_polynomial S₁ R)))

/--
The ring isomorphism between multivariable polynomials in `option S₁` and
multivariable polynomials with coefficients in polynomials.
-/
def option_equiv_right (R : Type u) (S₁ : Type v) [comm_semiring R] : mv_polynomial (Option S₁) R ≃+* mv_polynomial S₁ (polynomial R) :=
  ring_equiv.trans (ring_equiv_of_equiv R (equiv.option_equiv_sum_punit S₁))
    (ring_equiv.trans (sum_ring_equiv R S₁ Unit) (ring_equiv_congr (mv_polynomial Unit R) (punit_ring_equiv R)))

/--
The ring isomorphism between multivariable polynomials in `fin (n + 1)` and
polynomials over multivariable polynomials in `fin n`.
-/
def fin_succ_equiv (R : Type u) [comm_semiring R] (n : ℕ) : mv_polynomial (fin (n + 1)) R ≃+* polynomial (mv_polynomial (fin n) R) :=
  ring_equiv.trans (ring_equiv_of_equiv R (fin_succ_equiv n)) (option_equiv_left R (fin n))

theorem fin_succ_equiv_eq (R : Type u) [comm_semiring R] (n : ℕ) : ↑(fin_succ_equiv R n) =
  eval₂_hom (ring_hom.comp polynomial.C C)
    fun (i : fin (n + 1)) => fin.cases polynomial.X (fun (k : fin n) => coe_fn polynomial.C (X k)) i := sorry

@[simp] theorem fin_succ_equiv_apply (R : Type u) [comm_semiring R] (n : ℕ) (p : mv_polynomial (fin (n + 1)) R) : coe_fn (fin_succ_equiv R n) p =
  coe_fn
    (eval₂_hom (ring_hom.comp polynomial.C C)
      fun (i : fin (n + 1)) => fin.cases polynomial.X (fun (k : fin n) => coe_fn polynomial.C (X k)) i)
    p := sorry

theorem fin_succ_equiv_comp_C_eq_C {R : Type u} [comm_semiring R] (n : ℕ) : ring_hom.comp (ring_equiv.to_ring_hom (ring_equiv.symm (fin_succ_equiv R n))) (ring_hom.comp polynomial.C C) = C := sorry


import data.nat.nth

/-! # IMO 2017 C7 -/

namespace IMOSL
namespace IMO2017C7

open finset function

noncomputable def nth_notin (X : finset ℕ) := nat.nth (λ n, n ∉ X)
noncomputable def cup_mul (X Y : finset ℕ) := X ∪ image (nth_notin X) Y
noncomputable def cup_pow (X : finset ℕ) (k : ℕ) := nat.iterate (λ Y, cup_mul X Y) k ∅
local infix ` ** `:80 := cup_mul
local infix ` ^^ `:100 := cup_pow

section strict_mono

private lemma strict_mono_eq_at_large_comm {f g : ℕ → ℕ} (hf : strict_mono f) (hg : strict_mono g)
  (h : ∃ N : ℕ, ∀ n : ℕ, N ≤ n → f n = g n) (h0 : f ∘ g = g ∘ f) : f = g :=
begin
  cases h with N h,
  ext n; have h1 := n.zero_le; revert h1 n,
  refine nat.decreasing_induction (λ k h1 n h2, _) N.zero_le h,
  rw [le_iff_lt_or_eq, ← nat.add_one_le_iff] at h2,
  rcases h2 with h2 | rfl,
  exact h1 n h2,
  cases eq_or_lt_of_le (hf.id_le k) with h3 h3,
  cases eq_or_lt_of_le (hg.id_le k) with h4 h4,
  rw [← h3, ← h4],
  { replace h1 := h1 (g k) h4,
    rw [← comp_app f, h0, comp_app] at h1,
    exact hg.injective h1 },
  { replace h1 := h1 (f k) h3,
    rw [← comp_app g, ← h0, comp_app] at h1,
    exact hf.injective h1 }
end

end strict_mono

section prop_lemmas

private lemma count_true : nat.count (λ _, true) = id :=
begin
 ext n; induction n with n n_ih,
 rw [nat.count_zero, id.def],
 rw [nat.count_succ, n_ih, if_true, id.def, id.def]
end

private lemma nth_true : nat.nth (λ _, true) = id :=
begin
  ext n; have h := nat.nth_count (λ _, true) (trivial : (λ _, true) n),
  rwa count_true at h
end

variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q]

private lemma count_prop_inj (h : ∀ n : ℕ, nat.count p n = nat.count q n) : p = q :=
  by ext n; rw [← @nat.count_succ_eq_succ_count_iff p, h, h, nat.count_succ_eq_succ_count_iff]

private lemma nth_prop_inj (hp : (set_of p).infinite) (hq : (set_of q).infinite) :
  nat.nth p = nat.nth q ↔ p = q :=
begin
  symmetry; split,
  intros h; rw h,
  intros h; refine count_prop_inj (λ n, _),
  exact galois_connection.l_unique (nat.count_nth_gc _ hp) (nat.count_nth_gc _ hq) (λ b, by rw h)
end

end prop_lemmas

section finset_lemmas

variables (X Y : finset ℕ)

private lemma nat_finset_infinite_compl : {n : ℕ | n ∉ X}.infinite :=
begin
  have h := set.finite.infinite_compl ((X : set ℕ).to_finite),
  rwa set.compl_def at h
end

private lemma range_nth_notin_eq_compl : set.range (nth_notin X) = Xᶜ :=
begin
  ext n; rw [set.mem_range, set.mem_compl_iff, mem_coe],
  refine ⟨_, (λ h, ⟨nat.count (λ n, n ∉ X) n, _⟩)⟩,
  rintros ⟨y, rfl⟩,
  exact nat.nth_mem_of_infinite (λ n, n ∉ X) (nat_finset_infinite_compl X) y,
  exact nat.nth_count (λ (n : ℕ), n ∉ X) h
end

private lemma range_nth_notin_eq_univ_diff : set.range (nth_notin X) = set.univ \ X :=
  by rw [range_nth_notin_eq_compl, set.compl_eq_univ_diff]

private lemma nth_notin_inj : nth_notin X = nth_notin Y ↔ X = Y :=
begin
  unfold nth_notin,
  rw nth_prop_inj (nat_finset_infinite_compl X) (nat_finset_infinite_compl Y),
  symmetry; split,
  intros h; rw h,
  intros h; ext n,
  replace h := congr_fun h n,
  simp only [eq_iff_iff] at h,
  rwa [← not_iff_not, ← mem_coe, set.not_not_mem, ← mem_coe, set.not_not_mem] at h
end

private lemma nth_notin_strict_mono : strict_mono (nth_notin X) :=
  nat.nth_strict_mono _ (nat_finset_infinite_compl X)

private lemma nth_notin_fn_inj : injective (nth_notin X) :=
  strict_mono.injective (nth_notin_strict_mono X)

private lemma nth_notin_empty : nth_notin ∅ = id :=
  by simp [nth_notin, nth_true]

private lemma count_notin_large {n : ℕ} (h : X.sup id < n) :
  nat.count (λ x, x ∉ X) (n + X.card) = n :=
begin
  have h0 := congr_arg card (filter_union_filter_neg_eq (λ x, x ∈ X) (range (n + X.card))),
  rw [card_range, card_union_eq, ← nat.count_eq_card_filter_range,
      ← nat.count_eq_card_filter_range, nat.count_eq_card_fintype] at h0,
  work_on_goal 2 { rw disjoint_iff_inter_eq_empty, exact filter_inter_filter_neg_eq _ _ _ },
  rw [← add_left_inj X.card, add_comm]; convert h0 using 2; clear h0,
  suffices : ∀ k : ℕ, k ∈ X ↔ (k < n + X.card ∧ k ∈ X),
    rw eq_comm; convert fintype.subtype_card X this, -- Why doesn't it work with `exact`???
  simp only [iff_and_self]; intros k h0,
  refine lt_of_le_of_lt (le_sup h0) (lt_trans h _),
  rw [lt_add_iff_pos_right, pos_iff_ne_zero, ne.def, card_eq_zero],
  rintros rfl; exact h0
end

private lemma nth_notin_large {n : ℕ} (h : X.sup id < n) : nth_notin X n = n + X.card :=
begin
  have h0 := nat_finset_infinite_compl X,
  rw [nth_notin, eq_comm, eq_iff_le_not_lt]; split,
  rw [← nat.count_le_iff_le_nth _ h0, count_notin_large X h],
  rw [← nat.succ_le_iff, ← nat.count_le_iff_le_nth _ h0, nat.count_succ, count_notin_large X h,
      add_le_iff_nonpos_right, nonpos_iff_eq_zero, ← ne.def, ite_ne_right_iff, and_comm],
  refine ⟨one_ne_zero, λ h1, _⟩,
  replace h1 : id (n + X.card) ≤ X.sup id := le_sup h1,
  rw [id.def, ← not_lt] at h1,
  exact h1 (lt_of_lt_of_le h le_self_add)
end

end finset_lemmas

section cup_mul_lemmas

lemma cup_mul_empty (X : finset ℕ) : X ** ∅ = X :=
  by rw [cup_mul, image_empty, union_empty]

lemma empty_cup_mul (X : finset ℕ) : ∅ ** X = X :=
  by rw [cup_mul, empty_union, nth_notin_empty, image_id]

/-- For any `X Y : finset ℕ`, `|X ** Y| = |X| + |Y|`. -/
lemma cup_mul_card (X Y : finset ℕ) : (X ** Y).card = X.card + Y.card :=
begin
  rw [cup_mul, card_disjoint_union, card_image_of_injective Y (nth_notin_fn_inj X)],
  rw disjoint_right; intros a h1 h0,
  rw ← mem_coe at h1,
  replace h1 : a ∈ set.range (nth_notin X) := coe_image_subset_range h1,
  rw [range_nth_notin_eq_compl, set.mem_compl_iff, finset.mem_coe] at h1,
  exact h1 h0
end

/-- Lemma 1 in the official solution: `f_{X ** Y} = f_X ∘ f_Y` -/
lemma cup_mul_range (X Y : finset ℕ) : nth_notin (X ** Y) = nth_notin X ∘ nth_notin Y :=
begin
  rw ← well_founded.eq_strict_mono_iff_eq_range is_well_founded.wf (nth_notin_strict_mono _),
  work_on_goal 2 { exact strict_mono.comp (nth_notin_strict_mono _) (nth_notin_strict_mono _) },
  rw [range_nth_notin_eq_compl, set.range_comp, range_nth_notin_eq_univ_diff, set.image_diff,
      set.image_univ, range_nth_notin_eq_univ_diff, set.diff_diff, ← set.compl_eq_univ_diff,
      compl_inj_iff, cup_mul, coe_union, coe_image],
  exact nth_notin_fn_inj X
end

/-- The `cup_mul` operation is associative. -/
theorem cup_mul_assoc (X Y Z : finset ℕ) : X ** Y ** Z = X ** (Y ** Z) :=
  by rw ← nth_notin_inj; repeat { rw cup_mul_range }

/-- Lemma 2 in the official solution: if X ** Y = Y ** X and |X| = |Y| then X = Y -/
lemma cup_mul_comm_card_eq {X Y : finset ℕ} (h : X.card = Y.card) (h0 : X ** Y = Y ** X) : X = Y :=
begin
  rw ← nth_notin_inj at h0 ⊢,
  rw [cup_mul_range, cup_mul_range] at h0,
  refine strict_mono_eq_at_large_comm (nth_notin_strict_mono X) (nth_notin_strict_mono Y) _ h0,
  use max (X.sup id) (Y.sup id) + 1; intros n h1,
  rw [nat.succ_le_iff, max_lt_iff] at h1,
  cases h1 with h1 h2,
  rw [nth_notin_large X h1, nth_notin_large Y h2, h]
end

end cup_mul_lemmas

section cup_pow_lemmas

lemma cup_pow_zero (X : finset ℕ) : X ^^ 0 = ∅ := rfl

lemma cup_pow_succ (X : finset ℕ) (k : ℕ) : X ^^ k.succ = X ** X ^^ k :=
  by rw [cup_pow, cup_pow, iterate_succ', comp_app]

/- For any `X : finset ℕ` and `k : ℕ`, `|X^^k| = k |X|`. -/
lemma cup_pow_card (X : finset ℕ) (k : ℕ) : (X ^^ k).card = k * X.card :=
begin
  induction k with k k_ih,
  rw [cup_pow_zero, card_empty, zero_mul],
  rw [cup_pow_succ, cup_mul_card, k_ih, nat.succ_mul, add_comm]
end

/- If `X` commutes with `Y`, then `X^^k` commutes with `Y` for any `k`. -/
lemma cup_pow_comm' {X Y : finset ℕ} (h : X ** Y = Y ** X) (k : ℕ) :
  X ^^ k ** Y = Y ** X ^^ k :=
begin
  induction k with k k_ih,
  rw [cup_pow_zero, cup_mul_empty, empty_cup_mul],
  rw [cup_pow_succ, cup_mul_assoc, k_ih, ← cup_mul_assoc, ← cup_mul_assoc, h]
end

/- If `X` commutes with `Y`, then `X^^k` commutes with `Y^^m` for any `k` and `m`. -/
lemma cup_pow_comm {X Y : finset ℕ} (h : X ** Y = Y ** X) (k m : ℕ) :
  X ^^ k ** Y ^^ m = Y ^^ m ** X ^^ k :=
  cup_pow_comm' (eq_comm.mp (cup_pow_comm' (eq_comm.mp h) m)) k

end cup_pow_lemmas

/- Final solution -/
theorem final_solution (X Y : finset ℕ) (h : X ** Y = Y ** X) : X ^^ Y.card = Y ^^ X.card :=
begin
  refine cup_mul_comm_card_eq _ (cup_pow_comm h _ _),
  rw [cup_pow_card, cup_pow_card, mul_comm]
end

end IMO2017C7
end IMOSL


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.AuxLemmas
import LeanColls.Classes

namespace LeanColls

/-!
# Finger Trees

TODO: Describe

## References

See [Sozeau2007], section 4 and [Claessen2020]

-/
namespace FingerTree

inductive Digit (τ : Type u)
| _1 : τ → Digit τ
| _2 : τ → τ → Digit τ
| _3 : τ → τ → τ → Digit τ

namespace Digit

@[inline]
def tryAddLeft (d : Digit τ) (a : τ) (sc : Digit τ → α) (fc : τ → τ → τ → α) : α :=
  match d with
  | _1 b     => sc (_2 a b)
  | _2 b c   => sc (_3 a b c)
  | _3 b c d => fc b c d

@[inline]
def tryFront (d : Digit τ) (sc : τ → Digit τ → α) (fc : τ → α) : α :=
  match d with
  | _1 a       => fc a
  | _2 a b     => sc a (_1 b)
  | _3 a b c   => sc a (_2 b c)

@[inline]
def tryAddRight (d : Digit τ) (z : τ) (sc : Digit τ → α) (fc : τ → τ → τ → α) : α :=
  match h':d with
  | _1 y        => sc (_2 y z)
  | _2 x y      => sc (_3 x y z)
  | _3 w x y  => fc w x y

@[inline]
def tryBack (d : Digit τ) (sc : τ → Digit τ → α) (fc : τ → α) : α :=
  match d with
  | _1 z       => fc z
  | _2 y z     => sc z (_1 y)
  | _3 x y z   => sc z (_2 x y)

def toList : Digit τ → List τ
| _1 a       => [a]
| _2 a b     => [a,b]
| _3 a b c   => [a,b,c]

end Digit

inductive Node (τ : Type u)
| _2 : τ → τ → Node τ
| _3 : τ → τ → τ → Node τ

namespace Node

def toDigit : Node τ → Digit τ
| _2 a b => Digit._2 a b
| _3 a b c => Digit._3 a b c

def toList : Node τ → List τ
| _2 a b     => [a,b]
| _3 a b c   => [a,b,c]

theorem toList_toDigit {n : Node τ}
  : n.toDigit.toList = n.toList
  := by
  cases n
  repeat { simp [Digit.toList, toDigit, toList] }

end Node

open Node

def NodeTree (τ : Type u) : Nat → Type u
| 0 => τ
| (n+1) => Node (NodeTree τ n)

end FingerTree

open FingerTree

inductive FingerTree (τ : Type u) : (n : Nat) → Type u
| Empty : FingerTree τ n
| Single : NodeTree τ n → FingerTree τ n
| Deep : Digit (NodeTree τ n) → FingerTree τ (n+1) → Digit (NodeTree τ n) → FingerTree τ n

namespace FingerTree

def empty : FingerTree τ 0 := Empty

def toList : FingerTree τ n → List (NodeTree τ n)
| Empty => []
| Single x => [x]
| Deep pr tr sf =>
  pr.toList ++
  (tr.toList.bind Node.toList : List (NodeTree τ n)) ++
  sf.toList

@[inline]
def cons (f : FingerTree τ n) (a : NodeTree τ n) : FingerTree τ n :=
  match f with
  | Empty => Single a
  | Single b => Deep (Digit._1 a) Empty (Digit._1 b)
  | Deep pr tr sf =>
    Digit.tryAddLeft pr a
      (λ pr' => Deep pr' tr sf)
      (λ b c d => Deep (Digit._2 a b) (tr.cons (Node._2 c d)) sf)

@[inline]
def front? (f : FingerTree τ n) : Option (NodeTree τ n × FingerTree τ n) :=
  match f with
  | Empty         => none
  | Single a      => some (a, Empty)
  | Deep pr tr sf => some (
    Digit.tryFront pr
      (λ a pr' => (a, Deep pr' tr sf))
      (λ a => /- pr = Digit1 a -/ (a,
        match front? tr with
        | some (n, tr') => Deep n.toDigit tr' sf
        | none => /- tr empty -/
          Digit.tryFront sf
            (λ b sf' => Deep (Digit._1 b) Empty sf')
            (λ b => /- sf = Digit1 b -/
              Single b))))

@[simp]
theorem toList_cons (f : FingerTree τ n) (a : NodeTree τ n)
  : (f.cons a).toList = a :: f.toList
  := by
  induction f
  simp [cons, toList]
  simp [cons, toList, Digit.toList, List.bind, List.map, List.join]
  case Deep pr tr sf ih =>
  simp [cons, Digit.tryAddLeft]
  split
  simp [toList, Digit.toList, List.bind, List.map, List.join]
  simp [toList, Digit.toList, List.bind, List.map, List.join]
  case h_3 b c d =>
  simp [toList, Digit.toList, List.bind, List.map, List.join, ih]
  split
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join]
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join]
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join]

@[simp]
theorem toList_front (f : FingerTree τ n)
  : f.front?.map (λ (a,f') => (a,f'.toList)) = f.toList.front?
  := by
  induction f
  simp [front?, toList, List.front?, Option.map, Option.bind]
  simp [front?, toList, List.front?, Option.map, Option.bind]
  case Deep pr tr sf ih =>
  match pr with
  | Digit._2 a b     => simp [front?, toList, List.front?, Digit.tryFront, Option.map, Option.bind, HAppend.hAppend, Append.append, List.append]
  | Digit._3 a b c   => simp [front?, toList, List.front?, Digit.tryFront, Option.map, Option.bind, HAppend.hAppend, Append.append, List.append]
  | Digit._1 a =>
    match h:front? tr with
    | some (t,tr') =>
      rw [h] at ih
      simp [Option.map, Option.bind, List.front?] at ih
      split at ih
      contradiction
      case h_2 x h_tr =>
      cases ih
      simp [h,h_tr,front?, toList, List.front?, Digit.tryFront, Option.map, Option.bind, HAppend.hAppend, Append.append, List.append, List.bind, List.map, List.join]
      cases t
      repeat {simp [Digit.toList, Node.toDigit, Node.toList]}
    | none =>
      rw [h] at ih
      simp [Option.map, Option.bind, List.front?] at ih
      split at ih
      focus {
        case h_1 x h_tr =>
        simp [h,h_tr,front?, toList, List.front?, Digit.tryFront, Option.map, Option.bind, HAppend.hAppend, Append.append, List.append, List.bind, List.map, List.join]
        split
        repeat { simp [Digit.toList, toList, List.bind, List.join, List.map] }
      }
      contradiction

def snoc (f : FingerTree τ n) (z : NodeTree τ n) : FingerTree τ n :=
  match f with
  | Empty => Single z
  | Single b => Deep (Digit._1 b) Empty (Digit._1 z)
  | Deep pr tr sf =>
    Digit.tryAddRight sf z
      (λ sf' => Deep pr tr sf')
      (λ a b c => Deep pr (tr.snoc (Node._3 a b c)) (Digit._1 z))

def back? (f : FingerTree τ n) : Option (FingerTree τ n × NodeTree τ n) :=
  match f with
  | Empty         => none
  | Single z      => some (Empty, z)
  | Deep pr tr sf => some (
    Digit.tryBack sf
      (λ z sf' => (Deep pr tr sf', z))
      (λ z => /- sf = Digit1 z -/ (
        match back? tr with
        | some (tr', n) => Deep pr tr' n.toDigit
        | none => /- tr empty -/
          Digit.tryBack pr
            (λ y pr' => Deep pr' Empty (Digit._1 y))
            (λ y => /- pr = Digit1 y -/
              Single y),
        z)))

@[simp]
theorem toList_snoc (f : FingerTree τ n) (a : NodeTree τ n)
  : (f.snoc a).toList = f.toList.concat a
  := by
  induction f
  simp [snoc, toList, List.concat]
  simp [snoc, toList, Digit.toList, List.bind, List.map, List.join, List.concat]
  case Deep pr tr sf ih =>
  simp [snoc, Digit.tryAddRight]
  split
  simp [toList, Digit.toList, List.bind, List.map, List.join, List.concat_append, List.concat]
  simp [toList, Digit.toList, List.bind, List.map, List.join, List.concat_append, List.concat]
  case h_3 b c d e =>
  simp [toList, Digit.toList, List.bind, List.map, List.join, ih, List.concat_append, List.concat]
  split
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join, List.concat_append, List.concat, List.map_concat, List.join_concat, List.append_assoc]
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join, List.concat_append, List.concat, List.map_concat, List.join_concat, List.append_assoc]
  simp [toList, Digit.toList, Node.toList, List.bind, List.map, List.join, List.concat_append, List.concat, List.map_concat, List.join_concat, List.append_assoc]

@[simp]
theorem toList_back (f : FingerTree τ n)
  : f.back?.map (λ (f',a) => (f'.toList,a)) = f.toList.back?
  := by
  induction f
  simp [back?, toList, List.back?, Option.map, Option.bind]
  simp [back?, toList, List.back?, Option.map, Option.bind]
  case Deep pr tr sf ih =>
  match sf with
  | Digit._2 a b =>
    simp [toList, Digit.toList]
    have : [a,b] = [a].concat b := by rfl
    rw [this, ←List.concat_append, List.back_concat]
    simp [back?, Option.map, Option.bind, Digit.tryBack, toList, Digit.toList]
  | Digit._3 a b c =>
    simp [toList, Digit.toList]
    have : [a,b,c] = [a,b].concat c := by rfl
    rw [this, ←List.concat_append, List.back_concat]
    simp [back?, Option.map, Option.bind, Digit.tryBack, toList, Digit.toList]
  | Digit._1 a =>
    match h:back? tr with
    | some (tr',t) =>
      rw [h] at ih
      simp [Option.map, Option.bind] at ih
      have : toList tr = (toList tr').concat t :=
        (List.back_some_iff_concat _).mp ih.symm
      simp [this, back?, Digit.tryBack, Option.map, Option.bind, h, toList]
      have : Digit.toList (Digit._1 a) = [].concat a := by rfl
      rw [this]
      rw [←List.concat_append,List.back_concat]
      simp [List.bind, Node.toList_toDigit, List.append_assoc]
    | none =>
      rw [h] at ih
      simp [Option.map, Option.bind] at ih
      have : tr = Empty := by
        match tr with
        | Empty => rfl
        | Single _ => contradiction
        | Deep _ _ _ => contradiction
      simp [Option.map, Option.bind, back?, this, Digit.tryBack]
      simp [toList, Digit.toList, List.bind, List.map, List.join]
      have : [a] = [].concat a := by rfl
      rw [this]
      rw [←List.concat_append,List.back_concat]
      simp
      split
      repeat { simp [Digit.toList, toList, List.bind, List.join, List.map] }

theorem length_toList_deep {tr : FingerTree τ (n+1)}
  : List.length (toList tr) ≤ List.length (List.bind (toList tr) Node.toList)
  := by
  generalize toList tr = L
  simp [List.bind]
  induction L with
  | nil => simp [List.map, List.join]
  | cons l ls ih =>
  simp [List.map, List.join]
  suffices 1 ≤ List.length (Node.toList l) by
    have := Nat.add_le_add this ih
    rw [←Nat.add_one, Nat.add_comm]
    exact this
  simp [Node.toList]; split <;> simp

def append (f1 f2 : FingerTree τ n) : FingerTree τ n :=
  match f1, f2 with
  | f1, Empty => f1
  | Empty, f2 => f2
  | f1, Single z => f1.snoc z
  | Single a, f1 => f1.cons a
  | Deep pr1 tr1 sf1, Deep pr2 tr2 sf2 =>
    have : List.length (toList tr1) ≤ List.length (List.bind (toList tr1) Node.toList)
      := length_toList_deep
    have : List.length (toList tr2) ≤ List.length (List.bind (toList tr2) Node.toList)
      := length_toList_deep
    let tr' := match sf1, pr2 with
    | Digit._1 a,     Digit._1 b     => (tr1.snoc (Node._2 a b)).append tr2
    | Digit._2 a b,   Digit._1 c     => (tr1.snoc (Node._3 a b c)).append tr2
    | Digit._1 a,     Digit._2 b c   => tr1.append (tr2.cons (Node._3 a b c))
    | Digit._3 a b c, Digit._1 d     => (tr1.snoc (Node._2 a b)).append (tr2.cons (Node._2 c d))
    | Digit._2 a b,   Digit._2 c d   => (tr1.snoc (Node._2 a b)).append (tr2.cons (Node._2 c d))
    | Digit._1 a,     Digit._3 b c d => (tr1.snoc (Node._2 a b)).append (tr2.cons (Node._2 c d))
    | Digit._3 a b c, Digit._2 d e   => (tr1.snoc (Node._3 a b c)).append (tr2.cons (Node._2 d e))
    | Digit._2 a b,   Digit._3 c d e => (tr1.snoc (Node._2 a b)).append (tr2.cons (Node._3 c d e))
    | Digit._3 a b c, Digit._3 d e f => (tr1.snoc (Node._3 a b c)).append (tr2.cons (Node._3 d e f))

    Deep pr1 tr' sf2
  termination_by _ f1 f2 => f1.toList.length + f2.toList.length
  decreasing_by
    sorry

instance {α} : Enumerable (FingerTree α 0) α where
  ρ := FingerTree α 0
  fromEnumerator := id
  insert := λ
    | none => empty
    | some (x,ft) => ft.cons x

instance {α} : Iterable (FingerTree α 0) α where
  ρ := FingerTree α 0
  toIterator := id
  step := front?

end FingerTree


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

import category_theory.preadditive.basic

/-!
# Preadditive structure on functor categories

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

If `C` and `D` are categories and `D` is preadditive,
then `C ⥤ D` is also preadditive.

-/

open_locale big_operators

namespace category_theory
open category_theory.limits preadditive

variables {C D : Type*} [category C] [category D] [preadditive D]

instance functor_category_preadditive : preadditive (C ⥤ D) :=
{ hom_group := λ F G,
  { add := λ α β,
    { app := λ X, α.app X + β.app X,
      naturality' := by { intros, rw [comp_add, add_comp, α.naturality, β.naturality] } },
    zero := { app := λ X, 0, naturality' := by { intros, rw [zero_comp, comp_zero] } },
    neg := λ α,
    { app := λ X, -α.app X,
      naturality' := by { intros, rw [comp_neg, neg_comp, α.naturality] } },
    sub := λ α β,
    { app := λ X, α.app X - β.app X,
      naturality' := by { intros, rw [comp_sub, sub_comp, α.naturality, β.naturality] } },
    add_assoc := by { intros, ext, apply add_assoc },
    zero_add := by { intros, ext, apply zero_add },
    add_zero := by { intros, ext, apply add_zero },
    sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg },
    add_left_neg := by { intros, ext, apply add_left_neg },
    add_comm := by { intros, ext, apply add_comm } },
  add_comp' := by { intros, ext, apply add_comp },
  comp_add' := by { intros, ext, apply comp_add } }

namespace nat_trans

variables {F G : C ⥤ D}

/-- Application of a natural transformation at a fixed object,
as group homomorphism -/
@[simps] def app_hom (X : C) : (F ⟶ G) →+ (F.obj X ⟶ G.obj X) :=
{ to_fun := λ α, α.app X,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

@[simp] lemma app_zero (X : C) : (0 : F ⟶ G).app X = 0 := rfl

@[simp]

@[simp] lemma app_sub (X : C) (α β : F ⟶ G) : (α - β).app X = α.app X - β.app X := rfl

@[simp] lemma app_neg (X : C) (α : F ⟶ G) : (-α).app X = -α.app X := rfl

@[simp] lemma app_nsmul (X : C) (α : F ⟶ G) (n : ℕ) : (n • α).app X = n • α.app X :=
(app_hom X).map_nsmul α n

@[simp] lemma app_zsmul (X : C) (α : F ⟶ G) (n : ℤ) : (n • α).app X = n • α.app X :=
(app_hom X : (F ⟶ G) →+ (F.obj X ⟶ G.obj X)).map_zsmul α n

@[simp] lemma app_sum {ι : Type*} (s : finset ι) (X : C) (α : ι → (F ⟶ G)) :
  (∑ i in s, α i).app X = ∑ i in s, ((α i).app X) :=
by { rw [← app_hom_apply, add_monoid_hom.map_sum], refl }

end nat_trans

end category_theory


import natural.definition

@[derive decidable_eq]
inductive Z
| pos (n : N) : Z
| neg_succ (n : N) : Z

namespace Z

instance : has_zero Z := ⟨ pos N.zero ⟩
theorem zero_eq_zero : pos N.zero = 0 := rfl

def one : Z := pos (N.succ 0)

instance : has_one Z := ⟨ Z.one ⟩
theorem one_eq_one : one = 1 := rfl

lemma reduce_one : 1 = pos (N.succ 0) := rfl

theorem eq_comm (a b : Z) : (a = b) -> (b = a) :=
begin
  intro h,
  rw h,
end

lemma eq_pos_eq (a b : N) : (a = b) -> (pos a = pos b) :=
begin
  intro h,
  rw h,
end

lemma eq_neg_eq (a b : N) : (a = b) -> (neg_succ a = neg_succ b) :=
begin
  intro h,
  rw h,
end

lemma pos_neq_neg (a b : N) : pos a ≠ neg_succ b :=
begin
  intro h,
  cases h,
end

lemma neg_neq_pos (a b : N) : neg_succ a ≠ pos b :=
begin
  intro h,
  cases h,
end

theorem int1_to_nat (q : Prop) : (∀ (a: Z), q) -> (∀ (b: N), q) :=
begin
  intro h,
  intro a,
  have b := pos a,
  exact h b,
end

theorem int2_to_nat (q : Prop) : (∀ (a b: Z), q) -> (∀ (c d: N), q) :=
begin
  intro h,
  intros a b,
  have c := pos a,
  have d := pos b,
  exact h c d,
end

end Z


theorem foo1 (x : Nat) : 0 + x = x := by
  first
   | skip; have : x + x = x + x := rfl; done
          --^ $/lean/plainGoal
   | simp

theorem foo2 (x : Nat) : 0 + x = x := by
  induction x with
  | zero => done
          --^ $/lean/plainGoal
  | succ => done


variable {α : Type*}

def is_prefix (l₁ : list α) (l₂ : list α) : Prop :=
∃ t, l₁ ++ t = l₂

infix ` <+: `:50 := is_prefix

@[simp, refl]
theorem list.is_prefix_refl (l : list α) : l <+: l :=
⟨[], by simp⟩

example : [1, 2, 3] <+: [1, 2, 3] := by reflexivity