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

! This file was ported from Lean 3 source module topology.metric_space.pi_nat
! leanprover-community/mathlib commit e1a7bdeb4fd826b7e71d130d34988f0a2d26a177
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.RingExp
import Mathbin.Topology.MetricSpace.HausdorffDistance

/-!
# Topological study of spaces `Π (n : ℕ), E n`

When `E n` are topological spaces, the space `Π (n : ℕ), E n` is naturally a topological space
(with the product topology). When `E n` are uniform spaces, it also inherits a uniform structure.
However, it does not inherit a canonical metric space structure of the `E n`. Nevertheless, one
can put a noncanonical metric space structure (or rather, several of them). This is done in this
file.

## Main definitions and results

One can define a combinatorial distance on `Π (n : ℕ), E n`, as follows:

* `pi_nat.cylinder x n` is the set of points `y` with `x i = y i` for `i < n`.
* `pi_nat.first_diff x y` is the first index at which `x i ≠ y i`.
* `pi_nat.dist x y` is equal to `(1/2) ^ (first_diff x y)`. It defines a distance
  on `Π (n : ℕ), E n`, compatible with the topology when the `E n` have the discrete topology.
* `pi_nat.metric_space`: the metric space structure, given by this distance. Not registered as an
  instance. This space is a complete metric space.
* `pi_nat.metric_space_of_discrete_uniformity`: the same metric space structure, but adjusting the
  uniformity defeqness when the `E n` already have the discrete uniformity. Not registered as an
  instance
* `pi_nat.metric_space_nat_nat`: the particular case of `ℕ → ℕ`, not registered as an instance.

These results are used to construct continuous functions on `Π n, E n`:

* `pi_nat.exists_retraction_of_is_closed`: given a nonempty closed subset `s` of `Π (n : ℕ), E n`,
  there exists a retraction onto `s`, i.e., a continuous map from the whole space to `s`
  restricting to the identity on `s`.
* `exists_nat_nat_continuous_surjective_of_complete_space`: given any nonempty complete metric
  space with second-countable topology, there exists a continuous surjection from `ℕ → ℕ` onto
  this space.

One can also put distances on `Π (i : ι), E i` when the spaces `E i` are metric spaces (not discrete
in general), and `ι` is countable.

* `pi_countable.dist` is the distance on `Π i, E i` given by
    `dist x y = ∑' i, min (1/2)^(encode i) (dist (x i) (y i))`.
* `pi_countable.metric_space` is the corresponding metric space structure, adjusted so that
  the uniformity is definitionally the product uniformity. Not registered as an instance.
-/

noncomputable section

open Classical Topology Filter

open TopologicalSpace Set Metric Filter Function

attribute [local simp] pow_le_pow_iff one_lt_two inv_le_inv

variable {E : ℕ → Type _}

namespace PiNat

/-! ### The first_diff function -/

/-- In a product space `Π n, E n`, then `first_diff x y` is the first index at which `x` and `y`
differ. If `x = y`, then by convention we set `first_diff x x = 0`. -/
@[pp_nodot]
irreducible_def firstDiff (x y : ∀ n, E n) : ℕ :=
  if h : x ≠ y then Nat.find (ne_iff.1 h) else 0
#align pi_nat.first_diff PiNat.firstDiff

theorem apply_firstDiff_ne {x y : ∀ n, E n} (h : x ≠ y) : x (firstDiff x y) ≠ y (firstDiff x y) :=
  by
  rw [first_diff, dif_pos h]
  exact Nat.find_spec (ne_iff.1 h)
#align pi_nat.apply_first_diff_ne PiNat.apply_firstDiff_ne

theorem apply_eq_of_lt_firstDiff {x y : ∀ n, E n} {n : ℕ} (hn : n < firstDiff x y) : x n = y n :=
  by
  rw [first_diff] at hn
  split_ifs  at hn
  · convert Nat.find_min (ne_iff.1 h) hn
    simp
  · exact (not_lt_zero' hn).elim
#align pi_nat.apply_eq_of_lt_first_diff PiNat.apply_eq_of_lt_firstDiff

theorem firstDiff_comm (x y : ∀ n, E n) : firstDiff x y = firstDiff y x :=
  by
  rcases eq_or_ne x y with (rfl | hxy); · rfl
  rcases lt_trichotomy (first_diff x y) (first_diff y x) with (h | h | h)
  · exact (apply_first_diff_ne hxy (apply_eq_of_lt_first_diff h).symm).elim
  · exact h
  · exact (apply_first_diff_ne hxy.symm (apply_eq_of_lt_first_diff h).symm).elim
#align pi_nat.first_diff_comm PiNat.firstDiff_comm

theorem min_firstDiff_le (x y z : ∀ n, E n) (h : x ≠ z) :
    min (firstDiff x y) (firstDiff y z) ≤ firstDiff x z :=
  by
  by_contra' H
  have : x (first_diff x z) = z (first_diff x z) :=
    calc
      x (first_diff x z) = y (first_diff x z) :=
        apply_eq_of_lt_first_diff (H.trans_le (min_le_left _ _))
      _ = z (first_diff x z) := apply_eq_of_lt_first_diff (H.trans_le (min_le_right _ _))

  exact (apply_first_diff_ne h this).elim
#align pi_nat.min_first_diff_le PiNat.min_firstDiff_le

/-! ### Cylinders -/

/-- In a product space `Π n, E n`, the cylinder set of length `n` around `x`, denoted
`cylinder x n`, is the set of sequences `y` that coincide with `x` on the first `n` symbols, i.e.,
such that `y i = x i` for all `i < n`.
-/
def cylinder (x : ∀ n, E n) (n : ℕ) : Set (∀ n, E n) :=
  { y | ∀ i, i < n → y i = x i }
#align pi_nat.cylinder PiNat.cylinder

theorem cylinder_eq_pi (x : ∀ n, E n) (n : ℕ) :
    cylinder x n = Set.pi (Finset.range n : Set ℕ) fun i : ℕ => {x i} :=
  by
  ext y
  simp [cylinder]
#align pi_nat.cylinder_eq_pi PiNat.cylinder_eq_pi

@[simp]
theorem cylinder_zero (x : ∀ n, E n) : cylinder x 0 = univ := by simp [cylinder_eq_pi]
#align pi_nat.cylinder_zero PiNat.cylinder_zero

theorem cylinder_anti (x : ∀ n, E n) {m n : ℕ} (h : m ≤ n) : cylinder x n ⊆ cylinder x m :=
  fun y hy i hi => hy i (hi.trans_le h)
#align pi_nat.cylinder_anti PiNat.cylinder_anti

@[simp]
theorem mem_cylinder_iff {x y : ∀ n, E n} {n : ℕ} : y ∈ cylinder x n ↔ ∀ i, i < n → y i = x i :=
  Iff.rfl
#align pi_nat.mem_cylinder_iff PiNat.mem_cylinder_iff

theorem self_mem_cylinder (x : ∀ n, E n) (n : ℕ) : x ∈ cylinder x n := by simp
#align pi_nat.self_mem_cylinder PiNat.self_mem_cylinder

theorem mem_cylinder_iff_eq {x y : ∀ n, E n} {n : ℕ} :
    y ∈ cylinder x n ↔ cylinder y n = cylinder x n :=
  by
  constructor
  · intro hy
    apply subset.antisymm
    · intro z hz i hi
      rw [← hy i hi]
      exact hz i hi
    · intro z hz i hi
      rw [hy i hi]
      exact hz i hi
  · intro h
    rw [← h]
    exact self_mem_cylinder _ _
#align pi_nat.mem_cylinder_iff_eq PiNat.mem_cylinder_iff_eq

theorem mem_cylinder_comm (x y : ∀ n, E n) (n : ℕ) : y ∈ cylinder x n ↔ x ∈ cylinder y n := by
  simp [mem_cylinder_iff_eq, eq_comm]
#align pi_nat.mem_cylinder_comm PiNat.mem_cylinder_comm

theorem mem_cylinder_iff_le_firstDiff {x y : ∀ n, E n} (hne : x ≠ y) (i : ℕ) :
    x ∈ cylinder y i ↔ i ≤ firstDiff x y := by
  constructor
  · intro h
    by_contra'
    exact apply_first_diff_ne hne (h _ this)
  · intro hi j hj
    exact apply_eq_of_lt_first_diff (hj.trans_le hi)
#align pi_nat.mem_cylinder_iff_le_first_diff PiNat.mem_cylinder_iff_le_firstDiff

theorem mem_cylinder_firstDiff (x y : ∀ n, E n) : x ∈ cylinder y (firstDiff x y) := fun i hi =>
  apply_eq_of_lt_firstDiff hi
#align pi_nat.mem_cylinder_first_diff PiNat.mem_cylinder_firstDiff

theorem cylinder_eq_cylinder_of_le_firstDiff (x y : ∀ n, E n) {n : ℕ} (hn : n ≤ firstDiff x y) :
    cylinder x n = cylinder y n := by
  rw [← mem_cylinder_iff_eq]
  intro i hi
  exact apply_eq_of_lt_first_diff (hi.trans_le hn)
#align pi_nat.cylinder_eq_cylinder_of_le_first_diff PiNat.cylinder_eq_cylinder_of_le_firstDiff

theorem unionᵢ_cylinder_update (x : ∀ n, E n) (n : ℕ) :
    (⋃ k, cylinder (update x n k) (n + 1)) = cylinder x n :=
  by
  ext y
  simp only [mem_cylinder_iff, mem_Union]
  constructor
  · rintro ⟨k, hk⟩ i hi
    simpa [hi.ne] using hk i (Nat.lt_succ_of_lt hi)
  · intro H
    refine' ⟨y n, fun i hi => _⟩
    rcases Nat.lt_succ_iff_lt_or_eq.1 hi with (h'i | rfl)
    · simp [H i h'i, h'i.ne]
    · simp
#align pi_nat.Union_cylinder_update PiNat.unionᵢ_cylinder_update

theorem update_mem_cylinder (x : ∀ n, E n) (n : ℕ) (y : E n) : update x n y ∈ cylinder x n :=
  mem_cylinder_iff.2 fun i hi => by simp [hi.ne]
#align pi_nat.update_mem_cylinder PiNat.update_mem_cylinder

/-!
### A distance function on `Π n, E n`

We define a distance function on `Π n, E n`, given by `dist x y = (1/2)^n` where `n` is the first
index at which `x` and `y` differ. When each `E n` has the discrete topology, this distance will
define the right topology on the product space. We do not record a global `has_dist` instance nor
a `metric_space`instance, as other distances may be used on these spaces, but we register them as
local instances in this section.
-/

/-- The distance function on a product space `Π n, E n`, given by `dist x y = (1/2)^n` where `n` is
the first index at which `x` and `y` differ. -/
protected def hasDist : Dist (∀ n, E n) :=
  ⟨fun x y => if h : x ≠ y then (1 / 2 : ℝ) ^ firstDiff x y else 0⟩
#align pi_nat.has_dist PiNat.hasDist

attribute [local instance] PiNat.hasDist

theorem dist_eq_of_ne {x y : ∀ n, E n} (h : x ≠ y) : dist x y = (1 / 2 : ℝ) ^ firstDiff x y := by
  simp [dist, h]
#align pi_nat.dist_eq_of_ne PiNat.dist_eq_of_ne

protected theorem dist_self (x : ∀ n, E n) : dist x x = 0 := by simp [dist]
#align pi_nat.dist_self PiNat.dist_self

protected theorem dist_comm (x y : ∀ n, E n) : dist x y = dist y x := by
  simp [dist, @eq_comm _ x y, first_diff_comm]
#align pi_nat.dist_comm PiNat.dist_comm

protected theorem dist_nonneg (x y : ∀ n, E n) : 0 ≤ dist x y :=
  by
  rcases eq_or_ne x y with (rfl | h)
  · simp [dist]
  · simp [dist, h]
#align pi_nat.dist_nonneg PiNat.dist_nonneg

theorem dist_triangle_nonarch (x y z : ∀ n, E n) : dist x z ≤ max (dist x y) (dist y z) :=
  by
  rcases eq_or_ne x z with (rfl | hxz)
  · simp [PiNat.dist_self x, PiNat.dist_nonneg]
  rcases eq_or_ne x y with (rfl | hxy)
  · simp
  rcases eq_or_ne y z with (rfl | hyz)
  · simp
  simp only [dist_eq_of_ne, hxz, hxy, hyz, inv_le_inv, one_div, inv_pow, zero_lt_bit0, Ne.def,
    not_false_iff, le_max_iff, zero_lt_one, pow_le_pow_iff, one_lt_two, pow_pos,
    min_le_iff.1 (min_first_diff_le x y z hxz)]
#align pi_nat.dist_triangle_nonarch PiNat.dist_triangle_nonarch

protected theorem dist_triangle (x y z : ∀ n, E n) : dist x z ≤ dist x y + dist y z :=
  calc
    dist x z ≤ max (dist x y) (dist y z) := dist_triangle_nonarch x y z
    _ ≤ dist x y + dist y z := max_le_add_of_nonneg (PiNat.dist_nonneg _ _) (PiNat.dist_nonneg _ _)

#align pi_nat.dist_triangle PiNat.dist_triangle

protected theorem eq_of_dist_eq_zero (x y : ∀ n, E n) (hxy : dist x y = 0) : x = y :=
  by
  rcases eq_or_ne x y with (rfl | h); · rfl
  simp [dist_eq_of_ne h] at hxy
  exact (two_ne_zero (pow_eq_zero hxy)).elim
#align pi_nat.eq_of_dist_eq_zero PiNat.eq_of_dist_eq_zero

theorem mem_cylinder_iff_dist_le {x y : ∀ n, E n} {n : ℕ} :
    y ∈ cylinder x n ↔ dist y x ≤ (1 / 2) ^ n :=
  by
  rcases eq_or_ne y x with (rfl | hne)
  · simp [PiNat.dist_self]
  suffices (∀ i : ℕ, i < n → y i = x i) ↔ n ≤ first_diff y x by simpa [dist_eq_of_ne hne]
  constructor
  · intro hy
    by_contra' H
    exact apply_first_diff_ne hne (hy _ H)
  · intro h i hi
    exact apply_eq_of_lt_first_diff (hi.trans_le h)
#align pi_nat.mem_cylinder_iff_dist_le PiNat.mem_cylinder_iff_dist_le

theorem apply_eq_of_dist_lt {x y : ∀ n, E n} {n : ℕ} (h : dist x y < (1 / 2) ^ n) {i : ℕ}
    (hi : i ≤ n) : x i = y i :=
  by
  rcases eq_or_ne x y with (rfl | hne)
  · rfl
  have : n < first_diff x y := by
    simpa [dist_eq_of_ne hne, inv_lt_inv, pow_lt_pow_iff, one_lt_two] using h
  exact apply_eq_of_lt_first_diff (hi.trans_lt this)
#align pi_nat.apply_eq_of_dist_lt PiNat.apply_eq_of_dist_lt

/-- A function to a pseudo-metric-space is `1`-Lipschitz if and only if points in the same cylinder
of length `n` are sent to points within distance `(1/2)^n`.
Not expressed using `lipschitz_with` as we don't have a metric space structure -/
theorem lipschitz_with_one_iff_forall_dist_image_le_of_mem_cylinder {α : Type _}
    [PseudoMetricSpace α] {f : (∀ n, E n) → α} :
    (∀ x y : ∀ n, E n, dist (f x) (f y) ≤ dist x y) ↔
      ∀ x y n, y ∈ cylinder x n → dist (f x) (f y) ≤ (1 / 2) ^ n :=
  by
  constructor
  · intro H x y n hxy
    apply (H x y).trans
    rw [PiNat.dist_comm]
    exact mem_cylinder_iff_dist_le.1 hxy
  · intro H x y
    rcases eq_or_ne x y with (rfl | hne)
    · simp [PiNat.dist_nonneg]
    rw [dist_eq_of_ne hne]
    apply H x y (first_diff x y)
    rw [first_diff_comm]
    exact mem_cylinder_first_diff _ _
#align pi_nat.lipschitz_with_one_iff_forall_dist_image_le_of_mem_cylinder PiNat.lipschitz_with_one_iff_forall_dist_image_le_of_mem_cylinder

variable (E) [∀ n, TopologicalSpace (E n)] [∀ n, DiscreteTopology (E n)]

theorem isTopologicalBasis_cylinders :
    IsTopologicalBasis { s : Set (∀ n, E n) | ∃ (x : ∀ n, E n)(n : ℕ), s = cylinder x n } :=
  by
  apply is_topological_basis_of_open_of_nhds
  · rintro u ⟨x, n, rfl⟩
    rw [cylinder_eq_pi]
    exact isOpen_set_pi (Finset.range n).finite_toSet fun a ha => isOpen_discrete _
  · intro x u hx u_open
    obtain ⟨v, ⟨U, F, hUF, rfl⟩, xU, Uu⟩ :
      ∃ (v : Set (∀ i : ℕ, E i))(H :
        v ∈
          { S : Set (∀ i : ℕ, E i) |
            ∃ (U : ∀ i : ℕ, Set (E i))(F : Finset ℕ),
              (∀ i : ℕ, i ∈ F → U i ∈ { s : Set (E i) | IsOpen s }) ∧ S = (F : Set ℕ).pi U }),
        x ∈ v ∧ v ⊆ u :=
      (isTopologicalBasis_pi fun n : ℕ => is_topological_basis_opens).exists_subset_of_mem_open hx
        u_open
    rcases Finset.bddAbove F with ⟨n, hn⟩
    refine' ⟨cylinder x (n + 1), ⟨x, n + 1, rfl⟩, self_mem_cylinder _ _, subset.trans _ Uu⟩
    intro y hy
    suffices ∀ i : ℕ, i ∈ F → y i ∈ U i by simpa
    intro i hi
    have : y i = x i := mem_cylinder_iff.1 hy i ((hn hi).trans_lt (lt_add_one n))
    rw [this]
    simp only [Set.mem_pi, Finset.mem_coe] at xU
    exact xU i hi
#align pi_nat.is_topological_basis_cylinders PiNat.isTopologicalBasis_cylinders

variable {E}

theorem isOpen_iff_dist (s : Set (∀ n, E n)) :
    IsOpen s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s :=
  by
  constructor
  · intro hs x hx
    obtain ⟨v, ⟨y, n, rfl⟩, h'x, h's⟩ :
      ∃ (v : Set (∀ n : ℕ, E n))(H : v ∈ { s | ∃ (x : ∀ n : ℕ, E n)(n : ℕ), s = cylinder x n }),
        x ∈ v ∧ v ⊆ s :=
      (is_topological_basis_cylinders E).exists_subset_of_mem_open hx hs
    rw [← mem_cylinder_iff_eq.1 h'x] at h's
    exact
      ⟨(1 / 2 : ℝ) ^ n, by simp, fun y hy => h's fun i hi => (apply_eq_of_dist_lt hy hi.le).symm⟩
  · intro h
    apply (is_topological_basis_cylinders E).isOpen_iff.2 fun x hx => _
    rcases h x hx with ⟨ε, εpos, hε⟩
    obtain ⟨n, hn⟩ : ∃ n : ℕ, (1 / 2 : ℝ) ^ n < ε := exists_pow_lt_of_lt_one εpos one_half_lt_one
    refine' ⟨cylinder x n, ⟨x, n, rfl⟩, self_mem_cylinder x n, fun y hy => hε y _⟩
    rw [PiNat.dist_comm]
    exact (mem_cylinder_iff_dist_le.1 hy).trans_lt hn
#align pi_nat.is_open_iff_dist PiNat.isOpen_iff_dist

/-- Metric space structure on `Π (n : ℕ), E n` when the spaces `E n` have the discrete topology,
where the distance is given by `dist x y = (1/2)^n`, where `n` is the smallest index where `x` and
`y` differ. Not registered as a global instance by default.
Warning: this definition makes sure that the topology is defeq to the original product topology,
but it does not take care of a possible uniformity. If the `E n` have a uniform structure, then
there will be two non-defeq uniform structures on `Π n, E n`, the product one and the one coming
from the metric structure. In this case, use `metric_space_of_discrete_uniformity` instead. -/
protected def metricSpace : MetricSpace (∀ n, E n) :=
  MetricSpace.ofDistTopology dist PiNat.dist_self PiNat.dist_comm PiNat.dist_triangle
    isOpen_iff_dist PiNat.eq_of_dist_eq_zero
#align pi_nat.metric_space PiNat.metricSpace

/-- Metric space structure on `Π (n : ℕ), E n` when the spaces `E n` have the discrete uniformity,
where the distance is given by `dist x y = (1/2)^n`, where `n` is the smallest index where `x` and
`y` differ. Not registered as a global instance by default. -/
protected def metricSpaceOfDiscreteUniformity {E : ℕ → Type _} [∀ n, UniformSpace (E n)]
    (h : ∀ n, uniformity (E n) = 𝓟 idRel) : MetricSpace (∀ n, E n) :=
  haveI : ∀ n, DiscreteTopology (E n) := fun n => discreteTopology_of_discrete_uniformity (h n)
  { dist_triangle := PiNat.dist_triangle
    dist_comm := PiNat.dist_comm
    dist_self := PiNat.dist_self
    eq_of_dist_eq_zero := PiNat.eq_of_dist_eq_zero
    toUniformSpace := Pi.uniformSpace _
    uniformity_dist :=
      by
      simp [Pi.uniformity, comap_infi, gt_iff_lt, preimage_set_of_eq, comap_principal,
        PseudoMetricSpace.uniformity_dist, h, idRel]
      apply le_antisymm
      · simp only [le_infᵢ_iff, le_principal_iff]
        intro ε εpos
        obtain ⟨n, hn⟩ : ∃ n, (1 / 2 : ℝ) ^ n < ε := exists_pow_lt_of_lt_one εpos (by norm_num)
        apply
          @mem_infi_of_Inter _ _ _ _ _ (Finset.range n).finite_toSet fun i =>
            { p : (∀ n : ℕ, E n) × ∀ n : ℕ, E n | p.fst i = p.snd i }
        · simp only [mem_principal, set_of_subset_set_of, imp_self, imp_true_iff]
        · rintro ⟨x, y⟩ hxy
          simp only [Finset.mem_coe, Finset.mem_range, Inter_coe_set, mem_Inter, mem_set_of_eq] at
            hxy
          apply lt_of_le_of_lt _ hn
          rw [← mem_cylinder_iff_dist_le, mem_cylinder_iff]
          exact hxy
      · simp only [le_infᵢ_iff, le_principal_iff]
        intro n
        refine' mem_infi_of_mem ((1 / 2) ^ n) _
        refine' mem_infi_of_mem (by positivity) _
        simp only [mem_principal, set_of_subset_set_of, Prod.forall]
        intro x y hxy
        exact apply_eq_of_dist_lt hxy le_rfl }
#align pi_nat.metric_space_of_discrete_uniformity PiNat.metricSpaceOfDiscreteUniformity

/-- Metric space structure on `ℕ → ℕ` where the distance is given by `dist x y = (1/2)^n`,
where `n` is the smallest index where `x` and `y` differ.
Not registered as a global instance by default. -/
def metricSpaceNatNat : MetricSpace (ℕ → ℕ) :=
  PiNat.metricSpaceOfDiscreteUniformity fun n => rfl
#align pi_nat.metric_space_nat_nat PiNat.metricSpaceNatNat

attribute [local instance] PiNat.metricSpace

protected theorem completeSpace : CompleteSpace (∀ n, E n) :=
  by
  refine' Metric.complete_of_convergent_controlled_sequences (fun n => (1 / 2) ^ n) (by simp) _
  intro u hu
  refine' ⟨fun n => u n n, tendsto_pi_nhds.2 fun i => _⟩
  refine' tendsto_const_nhds.congr' _
  filter_upwards [Filter.Ici_mem_atTop i]with n hn
  exact apply_eq_of_dist_lt (hu i i n le_rfl hn) le_rfl
#align pi_nat.complete_space PiNat.completeSpace

/-!
### Retractions inside product spaces

We show that, in a space `Π (n : ℕ), E n` where each `E n` is discrete, there is a retraction on
any closed nonempty subset `s`, i.e., a continuous map `f` from the whole space to `s` restricting
to the identity on `s`. The map `f` is defined as follows. For `x ∈ s`, let `f x = x`. Otherwise,
consider the longest prefix `w` that `x` shares with an element of `s`, and let `f x = z_w`
where `z_w` is an element of `s` starting with `w`.
-/

theorem exists_disjoint_cylinder {s : Set (∀ n, E n)} (hs : IsClosed s) {x : ∀ n, E n}
    (hx : x ∉ s) : ∃ n, Disjoint s (cylinder x n) :=
  by
  rcases eq_empty_or_nonempty s with (rfl | hne)
  · exact ⟨0, by simp⟩
  have A : 0 < inf_dist x s := (hs.not_mem_iff_inf_dist_pos hne).1 hx
  obtain ⟨n, hn⟩ : ∃ n, (1 / 2 : ℝ) ^ n < inf_dist x s := exists_pow_lt_of_lt_one A one_half_lt_one
  refine' ⟨n, _⟩
  apply disjoint_left.2 fun y ys hy => _
  apply lt_irrefl (inf_dist x s)
  calc
    inf_dist x s ≤ dist x y := inf_dist_le_dist_of_mem ys
    _ ≤ (1 / 2) ^ n := by
      rw [mem_cylinder_comm] at hy
      exact mem_cylinder_iff_dist_le.1 hy
    _ < inf_dist x s := hn

#align pi_nat.exists_disjoint_cylinder PiNat.exists_disjoint_cylinder

/-- Given a point `x` in a product space `Π (n : ℕ), E n`, and `s` a subset of this space, then
`shortest_prefix_diff x s` if the smallest `n` for which there is no element of `s` having the same
prefix of length `n` as `x`. If there is no such `n`, then use `0` by convention. -/
def shortestPrefixDiff {E : ℕ → Type _} (x : ∀ n, E n) (s : Set (∀ n, E n)) : ℕ :=
  if h : ∃ n, Disjoint s (cylinder x n) then Nat.find h else 0
#align pi_nat.shortest_prefix_diff PiNat.shortestPrefixDiff

theorem firstDiff_lt_shortestPrefixDiff {s : Set (∀ n, E n)} (hs : IsClosed s) {x y : ∀ n, E n}
    (hx : x ∉ s) (hy : y ∈ s) : firstDiff x y < shortestPrefixDiff x s :=
  by
  have A := exists_disjoint_cylinder hs hx
  rw [shortest_prefix_diff, dif_pos A]
  have B := Nat.find_spec A
  contrapose! B
  rw [not_disjoint_iff_nonempty_inter]
  refine' ⟨y, hy, _⟩
  rw [mem_cylinder_comm]
  exact cylinder_anti y B (mem_cylinder_first_diff x y)
#align pi_nat.first_diff_lt_shortest_prefix_diff PiNat.firstDiff_lt_shortestPrefixDiff

theorem shortestPrefixDiff_pos {s : Set (∀ n, E n)} (hs : IsClosed s) (hne : s.Nonempty)
    {x : ∀ n, E n} (hx : x ∉ s) : 0 < shortestPrefixDiff x s :=
  by
  rcases hne with ⟨y, hy⟩
  exact (zero_le _).trans_lt (first_diff_lt_shortest_prefix_diff hs hx hy)
#align pi_nat.shortest_prefix_diff_pos PiNat.shortestPrefixDiff_pos

/-- Given a point `x` in a product space `Π (n : ℕ), E n`, and `s` a subset of this space, then
`longest_prefix x s` if the largest `n` for which there is an element of `s` having the same
prefix of length `n` as `x`. If there is no such `n`, use `0` by convention. -/
def longestPrefix {E : ℕ → Type _} (x : ∀ n, E n) (s : Set (∀ n, E n)) : ℕ :=
  shortestPrefixDiff x s - 1
#align pi_nat.longest_prefix PiNat.longestPrefix

theorem firstDiff_le_longestPrefix {s : Set (∀ n, E n)} (hs : IsClosed s) {x y : ∀ n, E n}
    (hx : x ∉ s) (hy : y ∈ s) : firstDiff x y ≤ longestPrefix x s :=
  by
  rw [longest_prefix, le_tsub_iff_right]
  · exact first_diff_lt_shortest_prefix_diff hs hx hy
  · exact shortest_prefix_diff_pos hs ⟨y, hy⟩ hx
#align pi_nat.first_diff_le_longest_prefix PiNat.firstDiff_le_longestPrefix

theorem inter_cylinder_longestPrefix_nonempty {s : Set (∀ n, E n)} (hs : IsClosed s)
    (hne : s.Nonempty) (x : ∀ n, E n) : (s ∩ cylinder x (longestPrefix x s)).Nonempty :=
  by
  by_cases hx : x ∈ s
  · exact ⟨x, hx, self_mem_cylinder _ _⟩
  have A := exists_disjoint_cylinder hs hx
  have B : longest_prefix x s < shortest_prefix_diff x s :=
    Nat.pred_lt (shortest_prefix_diff_pos hs hne hx).ne'
  rw [longest_prefix, shortest_prefix_diff, dif_pos A] at B⊢
  obtain ⟨y, ys, hy⟩ : ∃ y : ∀ n : ℕ, E n, y ∈ s ∧ x ∈ cylinder y (Nat.find A - 1) :=
    by
    have := Nat.find_min A B
    push_neg  at this
    simp_rw [not_disjoint_iff, mem_cylinder_comm] at this
    exact this
  refine' ⟨y, ys, _⟩
  rw [mem_cylinder_iff_eq] at hy⊢
  rw [hy]
#align pi_nat.inter_cylinder_longest_prefix_nonempty PiNat.inter_cylinder_longestPrefix_nonempty

theorem disjoint_cylinder_of_longestPrefix_lt {s : Set (∀ n, E n)} (hs : IsClosed s) {x : ∀ n, E n}
    (hx : x ∉ s) {n : ℕ} (hn : longestPrefix x s < n) : Disjoint s (cylinder x n) :=
  by
  rcases eq_empty_or_nonempty s with (h's | hne); · simp [h's]
  contrapose! hn
  rcases not_disjoint_iff_nonempty_inter.1 hn with ⟨y, ys, hy⟩
  apply le_trans _ (first_diff_le_longest_prefix hs hx ys)
  apply (mem_cylinder_iff_le_first_diff (ne_of_mem_of_not_mem ys hx).symm _).1
  rwa [mem_cylinder_comm]
#align pi_nat.disjoint_cylinder_of_longest_prefix_lt PiNat.disjoint_cylinder_of_longestPrefix_lt

/-- If two points `x, y` coincide up to length `n`, and the longest common prefix of `x` with `s`
is strictly shorter than `n`, then the longest common prefix of `y` with `s` is the same, and both
cylinders of this length based at `x` and `y` coincide. -/
theorem cylinder_longestPrefix_eq_of_longestPrefix_lt_firstDiff {x y : ∀ n, E n}
    {s : Set (∀ n, E n)} (hs : IsClosed s) (hne : s.Nonempty)
    (H : longestPrefix x s < firstDiff x y) (xs : x ∉ s) (ys : y ∉ s) :
    cylinder x (longestPrefix x s) = cylinder y (longestPrefix y s) :=
  by
  have l_eq : longest_prefix y s = longest_prefix x s :=
    by
    rcases lt_trichotomy (longest_prefix y s) (longest_prefix x s) with (L | L | L)
    · have Ax : (s ∩ cylinder x (longest_prefix x s)).Nonempty :=
        inter_cylinder_longest_prefix_nonempty hs hne x
      have Z := disjoint_cylinder_of_longest_prefix_lt hs ys L
      rw [first_diff_comm] at H
      rw [cylinder_eq_cylinder_of_le_first_diff _ _ H.le] at Z
      exact (Ax.not_disjoint Z).elim
    · exact L
    · have Ay : (s ∩ cylinder y (longest_prefix y s)).Nonempty :=
        inter_cylinder_longest_prefix_nonempty hs hne y
      have A'y : (s ∩ cylinder y (longest_prefix x s).succ).Nonempty :=
        Ay.mono (inter_subset_inter_right s (cylinder_anti _ L))
      have Z := disjoint_cylinder_of_longest_prefix_lt hs xs (Nat.lt_succ_self _)
      rw [cylinder_eq_cylinder_of_le_first_diff _ _ H] at Z
      exact (A'y.not_disjoint Z).elim
  rw [l_eq, ← mem_cylinder_iff_eq]
  exact cylinder_anti y H.le (mem_cylinder_first_diff x y)
#align pi_nat.cylinder_longest_prefix_eq_of_longest_prefix_lt_first_diff PiNat.cylinder_longestPrefix_eq_of_longestPrefix_lt_firstDiff

/-- Given a closed nonempty subset `s` of `Π (n : ℕ), E n`, there exists a Lipschitz retraction
onto this set, i.e., a Lipschitz map with range equal to `s`, equal to the identity on `s`. -/
theorem exists_lipschitz_retraction_of_isClosed {s : Set (∀ n, E n)} (hs : IsClosed s)
    (hne : s.Nonempty) :
    ∃ f : (∀ n, E n) → ∀ n, E n, (∀ x ∈ s, f x = x) ∧ range f = s ∧ LipschitzWith 1 f :=
  by
  /- The map `f` is defined as follows. For `x ∈ s`, let `f x = x`. Otherwise, consider the longest
    prefix `w` that `x` shares with an element of `s`, and let `f x = z_w` where `z_w` is an element
    of `s` starting with `w`. All the desired properties are clear, except the fact that `f`
    is `1`-Lipschitz: if two points `x, y` belong to a common cylinder of length `n`, one should show
    that their images also belong to a common cylinder of length `n`. This is a case analysis:
    * if both `x, y ∈ s`, then this is clear.
    * if `x ∈ s` but `y ∉ s`, then the longest prefix `w` of `y` shared by an element of `s` is of
    length at least `n` (because of `x`), and then `f y` starts with `w` and therefore stays in the
    same length `n` cylinder.
    * if `x ∉ s`, `y ∉ s`, let `w` be the longest prefix of `x` shared by an element of `s`. If its
    length is `< n`, then it is also the longest prefix of `y`, and we get `f x = f y = z_w`.
    Otherwise, `f x` remains in the same `n`-cylinder as `x`. Similarly for `y`. Finally, `f x` and
    `f y` are again in the same `n`-cylinder, as desired. -/
  set f := fun x => if x ∈ s then x else (inter_cylinder_longest_prefix_nonempty hs hne x).some with
    hf
  have fs : ∀ x ∈ s, f x = x := fun x xs => by simp [xs]
  refine' ⟨f, fs, _, _⟩
  -- check that the range of `f` is `s`.
  · apply subset.antisymm
    · rintro x ⟨y, rfl⟩
      by_cases hy : y ∈ s
      · rwa [fs y hy]
      simpa [hf, if_neg hy] using (inter_cylinder_longest_prefix_nonempty hs hne y).choose_spec.1
    · intro x hx
      rw [← fs x hx]
      exact mem_range_self _
  -- check that `f` is `1`-Lipschitz, by a case analysis.
  · apply LipschitzWith.mk_one fun x y => _
    -- exclude the trivial cases where `x = y`, or `f x = f y`.
    rcases eq_or_ne x y with (rfl | hxy)
    · simp
    rcases eq_or_ne (f x) (f y) with (h' | hfxfy)
    · simp [h', dist_nonneg]
    have I2 : cylinder x (first_diff x y) = cylinder y (first_diff x y) :=
      by
      rw [← mem_cylinder_iff_eq]
      apply mem_cylinder_first_diff
    suffices first_diff x y ≤ first_diff (f x) (f y) by
      simpa [dist_eq_of_ne hxy, dist_eq_of_ne hfxfy]
    -- case where `x ∈ s`
    by_cases xs : x ∈ s
    · rw [fs x xs] at hfxfy⊢
      -- case where `y ∈ s`, trivial
      by_cases ys : y ∈ s
      · rw [fs y ys]
      -- case where `y ∉ s`
      have A : (s ∩ cylinder y (longest_prefix y s)).Nonempty :=
        inter_cylinder_longest_prefix_nonempty hs hne y
      have fy : f y = A.some := by simp_rw [hf, if_neg ys]
      have I : cylinder A.some (first_diff x y) = cylinder y (first_diff x y) :=
        by
        rw [← mem_cylinder_iff_eq, first_diff_comm]
        apply cylinder_anti y _ A.some_spec.2
        exact first_diff_le_longest_prefix hs ys xs
      rwa [← fy, ← I2, ← mem_cylinder_iff_eq, mem_cylinder_iff_le_first_diff hfxfy.symm,
        first_diff_comm _ x] at I
    -- case where `x ∉ s`
    · by_cases ys : y ∈ s
      -- case where `y ∈ s` (similar to the above)
      · have A : (s ∩ cylinder x (longest_prefix x s)).Nonempty :=
          inter_cylinder_longest_prefix_nonempty hs hne x
        have fx : f x = A.some := by simp_rw [hf, if_neg xs]
        have I : cylinder A.some (first_diff x y) = cylinder x (first_diff x y) :=
          by
          rw [← mem_cylinder_iff_eq]
          apply cylinder_anti x _ A.some_spec.2
          apply first_diff_le_longest_prefix hs xs ys
        rw [fs y ys] at hfxfy⊢
        rwa [← fx, I2, ← mem_cylinder_iff_eq, mem_cylinder_iff_le_first_diff hfxfy] at I
      -- case where `y ∉ s`
      · have Ax : (s ∩ cylinder x (longest_prefix x s)).Nonempty :=
          inter_cylinder_longest_prefix_nonempty hs hne x
        have fx : f x = Ax.some := by simp_rw [hf, if_neg xs]
        have Ay : (s ∩ cylinder y (longest_prefix y s)).Nonempty :=
          inter_cylinder_longest_prefix_nonempty hs hne y
        have fy : f y = Ay.some := by simp_rw [hf, if_neg ys]
        -- case where the common prefix to `x` and `s`, or `y` and `s`, is shorter than the
        -- common part to `x` and `y` -- then `f x = f y`.
        by_cases H : longest_prefix x s < first_diff x y ∨ longest_prefix y s < first_diff x y
        · have : cylinder x (longest_prefix x s) = cylinder y (longest_prefix y s) :=
            by
            cases H
            · exact cylinder_longest_prefix_eq_of_longest_prefix_lt_first_diff hs hne H xs ys
            · symm
              rw [first_diff_comm] at H
              exact cylinder_longest_prefix_eq_of_longest_prefix_lt_first_diff hs hne H ys xs
          rw [fx, fy] at hfxfy
          apply (hfxfy _).elim
          congr
        -- case where the common prefix to `x` and `s` is long, as well as the common prefix to
        -- `y` and `s`. Then all points remain in the same cylinders.
        · push_neg  at H
          have I1 : cylinder Ax.some (first_diff x y) = cylinder x (first_diff x y) :=
            by
            rw [← mem_cylinder_iff_eq]
            exact cylinder_anti x H.1 Ax.some_spec.2
          have I3 : cylinder y (first_diff x y) = cylinder Ay.some (first_diff x y) :=
            by
            rw [eq_comm, ← mem_cylinder_iff_eq]
            exact cylinder_anti y H.2 Ay.some_spec.2
          have : cylinder Ax.some (first_diff x y) = cylinder Ay.some (first_diff x y) := by
            rw [I1, I2, I3]
          rw [← fx, ← fy, ← mem_cylinder_iff_eq, mem_cylinder_iff_le_first_diff hfxfy] at this
          exact this
#align pi_nat.exists_lipschitz_retraction_of_is_closed PiNat.exists_lipschitz_retraction_of_isClosed

/-- Given a closed nonempty subset `s` of `Π (n : ℕ), E n`, there exists a retraction onto this
set, i.e., a continuous map with range equal to `s`, equal to the identity on `s`. -/
theorem exists_retraction_of_isClosed {s : Set (∀ n, E n)} (hs : IsClosed s) (hne : s.Nonempty) :
    ∃ f : (∀ n, E n) → ∀ n, E n, (∀ x ∈ s, f x = x) ∧ range f = s ∧ Continuous f :=
  by
  rcases exists_lipschitz_retraction_of_is_closed hs hne with ⟨f, fs, frange, hf⟩
  exact ⟨f, fs, frange, hf.continuous⟩
#align pi_nat.exists_retraction_of_is_closed PiNat.exists_retraction_of_isClosed

theorem exists_retraction_subtype_of_isClosed {s : Set (∀ n, E n)} (hs : IsClosed s)
    (hne : s.Nonempty) : ∃ f : (∀ n, E n) → s, (∀ x : s, f x = x) ∧ Surjective f ∧ Continuous f :=
  by
  obtain ⟨f, fs, f_range, f_cont⟩ :
    ∃ f : (∀ n, E n) → ∀ n, E n, (∀ x ∈ s, f x = x) ∧ range f = s ∧ Continuous f :=
    exists_retraction_of_is_closed hs hne
  have A : ∀ x, f x ∈ s := by simp [← f_range]
  have B : ∀ x : s, cod_restrict f s A x = x :=
    by
    intro x
    apply subtype.coe_injective.eq_iff.1
    simpa only using fs x.val x.property
  exact ⟨cod_restrict f s A, B, fun x => ⟨x, B x⟩, f_cont.subtype_mk _⟩
#align pi_nat.exists_retraction_subtype_of_is_closed PiNat.exists_retraction_subtype_of_isClosed

end PiNat

open PiNat

/-- Any nonempty complete second countable metric space is the continuous image of the
fundamental space `ℕ → ℕ`. For a version of this theorem in the context of Polish spaces, see
`exists_nat_nat_continuous_surjective_of_polish_space`. -/
theorem exists_nat_nat_continuous_surjective_of_completeSpace (α : Type _) [MetricSpace α]
    [CompleteSpace α] [SecondCountableTopology α] [Nonempty α] :
    ∃ f : (ℕ → ℕ) → α, Continuous f ∧ Surjective f :=
  by
  /- First, we define a surjective map from a closed subset `s` of `ℕ → ℕ`. Then, we compose
    this map with a retraction of `ℕ → ℕ` onto `s` to obtain the desired map.
    Let us consider a dense sequence `u` in `α`. Then `s` is the set of sequences `xₙ` such that the
    balls `closed_ball (u xₙ) (1/2^n)` have a nonempty intersection. This set is closed, and we define
    `f x` there to be the unique point in the intersection. This function is continuous and surjective
    by design. -/
  letI : MetricSpace (ℕ → ℕ) := PiNat.metricSpaceNatNat
  have I0 : (0 : ℝ) < 1 / 2 := by norm_num
  have I1 : (1 / 2 : ℝ) < 1 := by norm_num
  rcases exists_dense_seq α with ⟨u, hu⟩
  let s : Set (ℕ → ℕ) := { x | (⋂ n : ℕ, closed_ball (u (x n)) ((1 / 2) ^ n)).Nonempty }
  let g : s → α := fun x => x.2.some
  have A : ∀ (x : s) (n : ℕ), dist (g x) (u ((x : ℕ → ℕ) n)) ≤ (1 / 2) ^ n := fun x n =>
    (mem_Inter.1 x.2.some_mem n : _)
  have g_cont : Continuous g :=
    by
    apply continuous_iff_continuousAt.2 fun y => _
    apply continuousAt_of_locally_lipschitz zero_lt_one 4 fun x hxy => _
    rcases eq_or_ne x y with (rfl | hne)
    · simp
    have hne' : x.1 ≠ y.1 := subtype.coe_injective.ne hne
    have dist' : dist x y = dist x.1 y.1 := rfl
    let n := first_diff x.1 y.1 - 1
    have diff_pos : 0 < first_diff x.1 y.1 :=
      by
      by_contra' h
      apply apply_first_diff_ne hne'
      rw [le_zero_iff.1 h]
      apply apply_eq_of_dist_lt _ le_rfl
      rw [pow_zero]
      exact hxy
    have hn : first_diff x.1 y.1 = n + 1 := (Nat.succ_pred_eq_of_pos diff_pos).symm
    rw [dist', dist_eq_of_ne hne', hn]
    have B : x.1 n = y.1 n := mem_cylinder_first_diff x.1 y.1 n (Nat.pred_lt diff_pos.ne')
    calc
      dist (g x) (g y) ≤ dist (g x) (u (x.1 n)) + dist (g y) (u (x.1 n)) :=
        dist_triangle_right _ _ _
      _ = dist (g x) (u (x.1 n)) + dist (g y) (u (y.1 n)) := by rw [← B]
      _ ≤ (1 / 2) ^ n + (1 / 2) ^ n := (add_le_add (A x n) (A y n))
      _ = 4 * (1 / 2) ^ (n + 1) := by ring

  have g_surj : surjective g := by
    intro y
    have : ∀ n : ℕ, ∃ j, y ∈ closed_ball (u j) ((1 / 2) ^ n) :=
      by
      intro n
      rcases hu.exists_dist_lt y (by simp : (0 : ℝ) < (1 / 2) ^ n) with ⟨j, hj⟩
      exact ⟨j, hj.le⟩
    choose x hx using this
    have I : (⋂ n : ℕ, closed_ball (u (x n)) ((1 / 2) ^ n)).Nonempty := ⟨y, mem_Inter.2 hx⟩
    refine' ⟨⟨x, I⟩, _⟩
    refine' dist_le_zero.1 _
    have J : ∀ n : ℕ, dist (g ⟨x, I⟩) y ≤ (1 / 2) ^ n + (1 / 2) ^ n := fun n =>
      calc
        dist (g ⟨x, I⟩) y ≤ dist (g ⟨x, I⟩) (u (x n)) + dist y (u (x n)) :=
          dist_triangle_right _ _ _
        _ ≤ (1 / 2) ^ n + (1 / 2) ^ n := add_le_add (A ⟨x, I⟩ n) (hx n)

    have L : tendsto (fun n : ℕ => (1 / 2 : ℝ) ^ n + (1 / 2) ^ n) at_top (𝓝 (0 + 0)) :=
      (tendsto_pow_atTop_nhds_0_of_lt_1 I0.le I1).add (tendsto_pow_atTop_nhds_0_of_lt_1 I0.le I1)
    rw [add_zero] at L
    exact ge_of_tendsto' L J
  have s_closed : IsClosed s :=
    by
    refine' is_closed_iff_cluster_pt.mpr _
    intro x hx
    have L : tendsto (fun n : ℕ => diam (closed_ball (u (x n)) ((1 / 2) ^ n))) at_top (𝓝 0) :=
      by
      have : tendsto (fun n : ℕ => (2 : ℝ) * (1 / 2) ^ n) at_top (𝓝 (2 * 0)) :=
        (tendsto_pow_atTop_nhds_0_of_lt_1 I0.le I1).const_mul _
      rw [MulZeroClass.mul_zero] at this
      exact
        squeeze_zero (fun n => diam_nonneg) (fun n => diam_closed_ball (pow_nonneg I0.le _)) this
    refine'
      nonempty_Inter_of_nonempty_bInter (fun n => is_closed_ball) (fun n => bounded_closed_ball) _ L
    intro N
    obtain ⟨y, hxy, ys⟩ : ∃ y, y ∈ ball x ((1 / 2) ^ N) ∩ s :=
      clusterPt_principal_iff.1 hx _ (ball_mem_nhds x (pow_pos I0 N))
    have E :
      (⋂ (n : ℕ) (H : n ≤ N), closed_ball (u (x n)) ((1 / 2) ^ n)) =
        ⋂ (n : ℕ) (H : n ≤ N), closed_ball (u (y n)) ((1 / 2) ^ n) :=
      by
      congr
      ext1 n
      congr
      ext1 hn
      have : x n = y n := apply_eq_of_dist_lt (mem_ball'.1 hxy) hn
      rw [this]
    rw [E]
    apply nonempty.mono _ ys
    apply Inter_subset_Inter₂
  obtain ⟨f, -, f_surj, f_cont⟩ :
    ∃ f : (ℕ → ℕ) → s, (∀ x : s, f x = x) ∧ surjective f ∧ Continuous f :=
    by
    apply exists_retraction_subtype_of_is_closed s_closed
    simpa only [nonempty_coe_sort] using g_surj.nonempty
  exact ⟨g ∘ f, g_cont.comp f_cont, g_surj.comp f_surj⟩
#align exists_nat_nat_continuous_surjective_of_complete_space exists_nat_nat_continuous_surjective_of_completeSpace

namespace PiCountable

/-!
### Products of (possibly non-discrete) metric spaces
-/

variable {ι : Type _} [Encodable ι] {F : ι → Type _} [∀ i, MetricSpace (F i)]

open Encodable

/-- Given a countable family of metric spaces, one may put a distance on their product `Π i, E i`.
It is highly non-canonical, though, and therefore not registered as a global instance.
The distance we use here is `dist x y = ∑' i, min (1/2)^(encode i) (dist (x i) (y i))`. -/
protected def hasDist : Dist (∀ i, F i) :=
  ⟨fun x y => ∑' i : ι, min ((1 / 2) ^ encode i) (dist (x i) (y i))⟩
#align pi_countable.has_dist PiCountable.hasDist

attribute [local instance] PiCountable.hasDist

theorem dist_eq_tsum (x y : ∀ i, F i) :
    dist x y = ∑' i : ι, min ((1 / 2) ^ encode i) (dist (x i) (y i)) :=
  rfl
#align pi_countable.dist_eq_tsum PiCountable.dist_eq_tsum

theorem dist_summable (x y : ∀ i, F i) :
    Summable fun i : ι => min ((1 / 2) ^ encode i) (dist (x i) (y i)) :=
  by
  refine'
    summable_of_nonneg_of_le (fun i => _) (fun i => min_le_left _ _) summable_geometric_two_encode
  exact le_min (pow_nonneg (by norm_num) _) dist_nonneg
#align pi_countable.dist_summable PiCountable.dist_summable

theorem min_dist_le_dist_pi (x y : ∀ i, F i) (i : ι) :
    min ((1 / 2) ^ encode i) (dist (x i) (y i)) ≤ dist x y :=
  le_tsum (dist_summable x y) i fun j hj => le_min (by simp) dist_nonneg
#align pi_countable.min_dist_le_dist_pi PiCountable.min_dist_le_dist_pi

theorem dist_le_dist_pi_of_dist_lt {x y : ∀ i, F i} {i : ι} (h : dist x y < (1 / 2) ^ encode i) :
    dist (x i) (y i) ≤ dist x y := by
  simpa only [not_le.2 h, false_or_iff] using min_le_iff.1 (min_dist_le_dist_pi x y i)
#align pi_countable.dist_le_dist_pi_of_dist_lt PiCountable.dist_le_dist_pi_of_dist_lt

open BigOperators Topology

open Filter

open NNReal

variable (E)

/-- Given a countable family of metric spaces, one may put a distance on their product `Π i, E i`,
defining the right topology and uniform structure. It is highly non-canonical, though, and therefore
not registered as a global instance.
The distance we use here is `dist x y = ∑' n, min (1/2)^(encode i) (dist (x n) (y n))`. -/
protected def metricSpace : MetricSpace (∀ i, F i)
    where
  dist_self x := by simp [dist_eq_tsum]
  dist_comm x y := by simp [dist_eq_tsum, dist_comm]
  dist_triangle x y z :=
    by
    have I :
      ∀ i,
        min ((1 / 2) ^ encode i) (dist (x i) (z i)) ≤
          min ((1 / 2) ^ encode i) (dist (x i) (y i)) +
            min ((1 / 2) ^ encode i) (dist (y i) (z i)) :=
      fun i =>
      calc
        min ((1 / 2) ^ encode i) (dist (x i) (z i)) ≤
            min ((1 / 2) ^ encode i) (dist (x i) (y i) + dist (y i) (z i)) :=
          min_le_min le_rfl (dist_triangle _ _ _)
        _ =
            min ((1 / 2) ^ encode i)
              (min ((1 / 2) ^ encode i) (dist (x i) (y i)) +
                min ((1 / 2) ^ encode i) (dist (y i) (z i))) :=
          by
          convert congr_arg (coe : ℝ≥0 → ℝ)
                (min_add_distrib ((1 / 2 : ℝ≥0) ^ encode i) (nndist (x i) (y i))
                  (nndist (y i) (z i))) <;>
            simp
        _ ≤
            min ((1 / 2) ^ encode i) (dist (x i) (y i)) +
              min ((1 / 2) ^ encode i) (dist (y i) (z i)) :=
          min_le_right _ _

    calc
      dist x z ≤
          ∑' i,
            min ((1 / 2) ^ encode i) (dist (x i) (y i)) +
              min ((1 / 2) ^ encode i) (dist (y i) (z i)) :=
        tsum_le_tsum I (dist_summable x z) ((dist_summable x y).add (dist_summable y z))
      _ = dist x y + dist y z := tsum_add (dist_summable x y) (dist_summable y z)

  eq_of_dist_eq_zero := by
    intro x y hxy
    ext1 n
    rw [← dist_le_zero, ← hxy]
    apply dist_le_dist_pi_of_dist_lt
    rw [hxy]
    simp
  toUniformSpace := Pi.uniformSpace _
  uniformity_dist := by
    have I0 : (0 : ℝ) ≤ 1 / 2 := by norm_num
    have I1 : (1 / 2 : ℝ) < 1 := by norm_num
    simp only [Pi.uniformity, comap_infi, gt_iff_lt, preimage_set_of_eq, comap_principal,
      PseudoMetricSpace.uniformity_dist]
    apply le_antisymm
    · simp only [le_infᵢ_iff, le_principal_iff]
      intro ε εpos
      obtain ⟨K, hK⟩ :
        ∃ K : Finset ι, (∑' i : { j // j ∉ K }, (1 / 2 : ℝ) ^ encode (i : ι)) < ε / 2 :=
        ((tendsto_order.1 (tendsto_tsum_compl_atTop_zero fun i : ι => (1 / 2 : ℝ) ^ encode i)).2 _
            (half_pos εpos)).exists
      obtain ⟨δ, δpos, hδ⟩ : ∃ (δ : ℝ)(δpos : 0 < δ), (K.card : ℝ) * δ ≤ ε / 2 :=
        by
        rcases Nat.eq_zero_or_pos K.card with (hK | hK)
        ·
          exact
            ⟨1, zero_lt_one, by
              simpa only [hK, Nat.cast_zero, MulZeroClass.zero_mul] using (half_pos εpos).le⟩
        · have Kpos : 0 < (K.card : ℝ) := Nat.cast_pos.2 hK
          refine' ⟨ε / 2 / (K.card : ℝ), div_pos (half_pos εpos) Kpos, le_of_eq _⟩
          field_simp [Kpos.ne']
          ring
      apply
        @mem_infi_of_Inter _ _ _ _ _ K.finite_to_set fun i =>
          { p : (∀ i : ι, F i) × ∀ i : ι, F i | dist (p.fst i) (p.snd i) < δ }
      · rintro ⟨i, hi⟩
        refine' mem_infi_of_mem δ (mem_infi_of_mem δpos _)
        simp only [Prod.forall, imp_self, mem_principal]
      · rintro ⟨x, y⟩ hxy
        simp only [mem_Inter, mem_set_of_eq, SetCoe.forall, Finset.mem_range, Finset.mem_coe] at hxy
        calc
          dist x y = ∑' i : ι, min ((1 / 2) ^ encode i) (dist (x i) (y i)) := rfl
          _ =
              (∑ i in K, min ((1 / 2) ^ encode i) (dist (x i) (y i))) +
                ∑' i : (↑K : Set ι)ᶜ, min ((1 / 2) ^ encode (i : ι)) (dist (x i) (y i)) :=
            (sum_add_tsum_compl (dist_summable _ _)).symm
          _ ≤ (∑ i in K, dist (x i) (y i)) + ∑' i : (↑K : Set ι)ᶜ, (1 / 2) ^ encode (i : ι) :=
            by
            refine' add_le_add (Finset.sum_le_sum fun i hi => min_le_right _ _) _
            refine' tsum_le_tsum (fun i => min_le_left _ _) _ _
            · apply Summable.subtype (dist_summable x y) ((↑K : Set ι)ᶜ)
            · apply Summable.subtype summable_geometric_two_encode ((↑K : Set ι)ᶜ)
          _ < (∑ i in K, δ) + ε / 2 :=
            by
            apply add_lt_add_of_le_of_lt _ hK
            apply Finset.sum_le_sum fun i hi => _
            apply (hxy i _).le
            simpa using hi
          _ ≤ ε / 2 + ε / 2 :=
            (add_le_add_right (by simpa only [Finset.sum_const, nsmul_eq_mul] using hδ) _)
          _ = ε := add_halves _

    · simp only [le_infᵢ_iff, le_principal_iff]
      intro i ε εpos
      refine' mem_infi_of_mem (min ((1 / 2) ^ encode i) ε) _
      have : 0 < min ((1 / 2) ^ encode i) ε := lt_min (by simp) εpos
      refine' mem_infi_of_mem this _
      simp only [and_imp, Prod.forall, set_of_subset_set_of, lt_min_iff, mem_principal]
      intro x y hn hε
      calc
        dist (x i) (y i) ≤ dist x y := dist_le_dist_pi_of_dist_lt hn
        _ < ε := hε

#align pi_countable.metric_space PiCountable.metricSpace

end PiCountable


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

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_184
  (a b : nnreal)
  (h₀ : 0 < a ∧ 0 < b)
  (h₁ : (a^2) = 6*b)
  (h₂ : (a^2) = 54/b) :
  a = 3 * nnreal.sqrt 2 :=
begin
  have key₁ : b ≠ 0 := ne_of_gt h₀.2,
  have h₄ : 0 ≤ a, { exact zero_le _ },

  suffices : a^2=18,
  {
    rw eq_comm,
    have h₅ : 3 * nnreal.sqrt 2 = nnreal.sqrt 18,
    {
      calc 3 * nnreal.sqrt 2 = (nnreal.sqrt 9) * (nnreal.sqrt 2) : by {rw eq_comm, simp, rw nnreal.sqrt_eq_iff_sq_eq, ring}
                          ...= nnreal.sqrt (9 * 2): by {rw ← nnreal.sqrt_mul}
                          ...= nnreal.sqrt 18: by{ring_nf},
    },
    rw [h₅, nnreal.sqrt_eq_iff_sq_eq],
    rw ← this,
    ring,
  },

  have key₂ : (6 * b * b) = 54,
  {
    rw h₁ at h₂,
    exact (eq_div_iff key₁).mp h₂,
  },

  have key₃ : b = 3,
  {
    have key₅ : (6 : nnreal) ≠ 0,
    {
      refine nnreal.ne_iff.mp _,
      norm_num,
    },
    calc b = nnreal.sqrt (b * b) : by { rw eq_comm, apply nnreal.sqrt_mul_self}
          ... = nnreal.sqrt ((6*b*b)/6) : by {refine congr_arg ⇑nnreal.sqrt _, ring_nf, refine (eq_div_iff _).mpr _,
          {exact key₅},
          rw mul_comm,
          }
          ... = nnreal.sqrt (54/6): by {rw key₂}
          ... = nnreal.sqrt(9) : by {refine congr_arg ⇑nnreal.sqrt _, refine (div_eq_iff key₅).mpr _, ring,}
          ... = 3 : by {rw nnreal.sqrt_eq_iff_sq_eq, ring},
  },
  rw key₃ at h₁,
  rw h₁,
  ring,
end


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

import computability.encoding
import model_theory.syntax
import set_theory.cardinal.ordinal

/-! # Encodings and Cardinality of First-Order Syntax

## Main Definitions
* `first_order.language.term.encoding` encodes terms as lists.
* `first_order.language.bounded_formula.encoding` encodes bounded formulas as lists.

## Main Results
* `first_order.language.term.card_le` shows that the number of terms in `L.term α` is at most
`max ℵ₀ # (α ⊕ Σ i, L.functions i)`.
* `first_order.language.bounded_formula.card_le` shows that the number of bounded formulas in
`Σ n, L.bounded_formula α n` is at most
`max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card)`.

## TODO
* `primcodable` instances for terms and formulas, based on the `encoding`s
* Computability facts about term and formula operations, to set up a computability approach to
incompleteness

-/

universes u v w u' v'

namespace first_order
namespace language

variables {L : language.{u v}}
variables {M : Type w} {N P : Type*} [L.Structure M] [L.Structure N] [L.Structure P]
variables {α : Type u'} {β : Type v'}
open_locale first_order cardinal
open computability list Structure cardinal fin

namespace term

/-- Encodes a term as a list of variables and function symbols. -/
def list_encode : L.term α → list (α ⊕ Σ i, L.functions i)
| (var i) := [sum.inl i]
| (func f ts) := ((sum.inr (⟨_, f⟩ : Σ i, L.functions i)) ::
    ((list.fin_range _).bind (λ i, (ts i).list_encode)))

/-- Decodes a list of variables and function symbols as a list of terms. -/
def list_decode :
  list (α ⊕ Σ i, L.functions i) → list (option (L.term α))
| [] := []
| ((sum.inl a) :: l) := some (var a) :: list_decode l
| ((sum.inr ⟨n, f⟩) :: l) :=
  if h : ∀ (i : fin n), ((list_decode l).nth i).join.is_some
  then func f (λ i, option.get (h i)) :: ((list_decode l).drop n)
  else [none]

theorem list_decode_encode_list (l : list (L.term α)) :
  list_decode (l.bind list_encode) = l.map option.some :=
begin
  suffices h : ∀ (t : L.term α) (l : list (α ⊕ Σ i, L.functions i)),
    list_decode (t.list_encode ++ l) = some t :: list_decode l,
  { induction l with t l lih,
    { refl },
    { rw [cons_bind, h t (l.bind list_encode), lih, list.map] } },
  { intro t,
    induction t with a n f ts ih; intro l,
    { rw [list_encode, singleton_append, list_decode] },
    { rw [list_encode, cons_append, list_decode],
      have h : list_decode ((fin_range n).bind (λ (i : fin n), (ts i).list_encode) ++ l) =
        (fin_range n).map (option.some ∘ ts) ++ list_decode l,
      { induction (fin_range n) with i l' l'ih,
        { refl },
        { rw [cons_bind, append_assoc, ih, map_cons, l'ih, cons_append] } },
      have h' : ∀ i, (list_decode ((fin_range n).bind (λ (i : fin n), (ts i).list_encode) ++ l)).nth
        ↑i = some (some (ts i)),
      { intro i,
        rw [h, nth_append, nth_map],
        { simp only [option.map_eq_some', function.comp_app, nth_eq_some],
          refine ⟨i, ⟨lt_of_lt_of_le i.2 (ge_of_eq (length_fin_range _)), _⟩, rfl⟩,
          rw [nth_le_fin_range, fin.eta] },
        { refine lt_of_lt_of_le i.2 _,
          simp } },
      refine (dif_pos (λ i, option.is_some_iff_exists.2 ⟨ts i, _⟩)).trans _,
      { rw [option.join_eq_some, h'] },
      refine congr (congr rfl (congr rfl (congr rfl (funext (λ i, option.get_of_mem _ _))))) _,
      { simp [h'] },
      { rw [h, drop_left'],
        rw [length_map, length_fin_range] } } }
end

/-- An encoding of terms as lists. -/
@[simps] protected def encoding : encoding (L.term α) :=
{ Γ := α ⊕ Σ i, L.functions i,
  encode := list_encode,
  decode := λ l, (list_decode l).head'.join,
  decode_encode := λ t, begin
    have h := list_decode_encode_list [t],
    rw [bind_singleton] at h,
    simp only [h, option.join, head', list.map, option.some_bind, id.def],
  end }

lemma list_encode_injective :
  function.injective (list_encode : L.term α → list (α ⊕ Σ i, L.functions i)) :=
term.encoding.encode_injective

theorem card_le : # (L.term α) ≤ max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
lift_le.1 (trans term.encoding.card_le_card_list (lift_le.2 (mk_list_le_max _)))

theorem card_sigma : # (Σ n, (L.term (α ⊕ fin n))) = max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
begin
  refine le_antisymm _ _,
  { rw mk_sigma,
    refine (sum_le_supr_lift _).trans _,
    rw [mk_nat, lift_aleph_0, mul_eq_max_of_aleph_0_le_left le_rfl, max_le_iff,
      csupr_le_iff' (bdd_above_range _)],
    { refine ⟨le_max_left _ _, λ i, card_le.trans _⟩,
      rw max_le_iff,
      refine ⟨le_max_left _ _, _⟩,
      rw [← add_eq_max le_rfl, mk_sum, mk_sum, mk_sum, add_comm (cardinal.lift (#α)), lift_add,
        add_assoc, lift_lift, lift_lift],
      refine add_le_add_right _ _,
      rw [lift_le_aleph_0, ← encodable_iff],
      exact ⟨infer_instance⟩ },
    { rw [← one_le_iff_ne_zero],
      refine trans _ (le_csupr (bdd_above_range _) 1),
      rw [one_le_iff_ne_zero, mk_ne_zero_iff],
      exact ⟨var (sum.inr 0)⟩ } },
  { rw [max_le_iff, ← infinite_iff],
    refine ⟨infinite.of_injective (λ i, ⟨i + 1, var (sum.inr i)⟩) (λ i j ij, _), _⟩,
    { cases ij,
      refl },
    { rw [cardinal.le_def],
      refine ⟨⟨sum.elim (λ i, ⟨0, var (sum.inl i)⟩)
        (λ F, ⟨1, func F.2 (λ _, var (sum.inr 0))⟩), _⟩⟩,
      { rintros (a | a) (b | b) h,
        { simp only [sum.elim_inl, eq_self_iff_true, heq_iff_eq, true_and] at h,
          rw h },
        { simp only [sum.elim_inl, sum.elim_inr, nat.zero_ne_one, false_and] at h,
          exact h.elim },
        { simp only [sum.elim_inr, sum.elim_inl, nat.one_ne_zero, false_and] at h,
          exact h.elim },
        { simp only [sum.elim_inr, eq_self_iff_true, heq_iff_eq, true_and] at h,
          rw sigma.ext_iff.2 ⟨h.1, h.2.1⟩, } } } }
end

instance [encodable α] [encodable ((Σ i, L.functions i))] :
  encodable (L.term α) :=
encodable.of_left_injection list_encode (λ l, (list_decode l).head'.join)
  (λ t, begin
    rw [← bind_singleton list_encode, list_decode_encode_list],
    simp only [option.join, head', list.map, option.some_bind, id.def],
  end)

lemma card_le_aleph_0 [h1 : nonempty (encodable α)] [h2 : L.countable_functions] :
  # (L.term α) ≤ ℵ₀ :=
begin
  refine (card_le.trans _),
  rw [max_le_iff],
  simp only [le_refl, mk_sum, add_le_aleph_0, lift_le_aleph_0, true_and],
  exact ⟨encodable_iff.1 h1, L.card_functions_le_aleph_0⟩,
end

instance small [small.{u} α] :
  small.{u} (L.term α) :=
small_of_injective list_encode_injective

end term

namespace bounded_formula

/-- Encodes a bounded formula as a list of symbols. -/
def list_encode : ∀ {n : ℕ}, L.bounded_formula α n →
  list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)
| n falsum := [sum.inr (sum.inr (n + 2))]
| n (equal t₁ t₂) := [sum.inl ⟨_, t₁⟩, sum.inl ⟨_, t₂⟩]
| n (rel R ts) := [sum.inr (sum.inl ⟨_, R⟩), sum.inr (sum.inr n)] ++
  ((list.fin_range _).map (λ i, sum.inl ⟨n, (ts i)⟩))
| n (imp φ₁ φ₂) := (sum.inr (sum.inr 0)) :: φ₁.list_encode ++ φ₂.list_encode
| n (all φ) := (sum.inr (sum.inr 1)) :: φ.list_encode

/-- Applies the `forall` quantifier to an element of `(Σ n, L.bounded_formula α n)`,
or returns `default` if not possible. -/
def sigma_all : (Σ n, L.bounded_formula α n) → Σ n, L.bounded_formula α n
| ⟨(n + 1), φ⟩ := ⟨n, φ.all⟩
| _ := default

/-- Applies `imp` to two elements of `(Σ n, L.bounded_formula α n)`,
or returns `default` if not possible. -/
def sigma_imp :
  (Σ n, L.bounded_formula α n) → (Σ n, L.bounded_formula α n) → (Σ n, L.bounded_formula α n)
| ⟨m, φ⟩ ⟨n, ψ⟩ := if h : m = n then ⟨m, φ.imp (eq.mp (by rw h) ψ)⟩ else default

/-- Decodes a list of symbols as a list of formulas. -/
@[simp] def list_decode :
  Π (l : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)),
    (Σ n, L.bounded_formula α n) ×
    { l' : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)
    // l'.sizeof ≤ max 1 l.sizeof }
| ((sum.inr (sum.inr (n + 2))) :: l) := ⟨⟨n, falsum⟩, l, le_max_of_le_right le_add_self⟩
| ((sum.inl ⟨n₁, t₁⟩) :: sum.inl ⟨n₂, t₂⟩ :: l) :=
    ⟨if h : n₁ = n₂ then ⟨n₁, equal t₁ (eq.mp (by rw h) t₂)⟩ else default, l, begin
      simp only [list.sizeof, ← add_assoc],
      exact le_max_of_le_right le_add_self,
    end⟩
| (sum.inr (sum.inl ⟨n, R⟩) :: (sum.inr (sum.inr k)) :: l) := ⟨
    if h : ∀ (i : fin n), ((l.map sum.get_left).nth i).join.is_some
    then if h' : ∀ i, (option.get (h i)).1 = k
      then ⟨k, bounded_formula.rel R (λ i, eq.mp (by rw h' i) (option.get (h i)).2)⟩
      else default
    else default,
    l.drop n, le_max_of_le_right (le_add_left (le_add_left (list.drop_sizeof_le _ _)))⟩
| ((sum.inr (sum.inr 0)) :: l) :=
  have (↑((list_decode l).2) : list ((Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ)).sizeof
    < 1 + (1 + 1) + l.sizeof, from begin
      refine lt_of_le_of_lt (list_decode l).2.2 (max_lt _ (nat.lt_add_of_pos_left dec_trivial)),
      rw [add_assoc, add_comm, nat.lt_succ_iff, add_assoc],
      exact le_self_add,
    end,
  ⟨sigma_imp (list_decode l).1 (list_decode (list_decode l).2).1,
    (list_decode (list_decode l).2).2, le_max_of_le_right (trans (list_decode _).2.2 (max_le
      (le_add_right le_self_add) (trans (list_decode _).2.2
      (max_le (le_add_right le_self_add) le_add_self))))⟩
| ((sum.inr (sum.inr 1)) :: l) := ⟨sigma_all (list_decode l).1, (list_decode l).2,
  (list_decode l).2.2.trans (max_le_max le_rfl le_add_self)⟩
| _ := ⟨default, [], le_max_left _ _⟩

@[simp] theorem list_decode_encode_list (l : list (Σ n, L.bounded_formula α n)) :
  (list_decode (l.bind (λ φ, φ.2.list_encode))).1 = l.head :=
begin
  suffices h : ∀ (φ : (Σ n, L.bounded_formula α n)) l,
    (list_decode (list_encode φ.2 ++ l)).1 = φ ∧ (list_decode (list_encode φ.2 ++ l)).2.1 = l,
  { induction l with φ l lih,
    { rw [list.nil_bind],
      simp [list_decode], },
    { rw [cons_bind, (h φ _).1, head_cons] } },
  { rintro ⟨n, φ⟩,
    induction φ with _ _ _ _ _ _ _ ts _ _ _ ih1 ih2 _ _ ih; intro l,
    { rw [list_encode, singleton_append, list_decode],
      simp only [eq_self_iff_true, heq_iff_eq, and_self], },
    { rw [list_encode, cons_append, cons_append, list_decode, dif_pos],
      { simp only [eq_mp_eq_cast, cast_eq, eq_self_iff_true, heq_iff_eq, and_self, nil_append], },
      { simp only [eq_self_iff_true, heq_iff_eq, and_self], } },
    { rw [list_encode, cons_append, cons_append, singleton_append, cons_append, list_decode],
      { have h : ∀ (i : fin φ_l), ((list.map sum.get_left (list.map (λ (i : fin φ_l),
          sum.inl (⟨(⟨φ_n, rel φ_R ts⟩ : Σ n, L.bounded_formula α n).fst, ts i⟩ :
            Σ n, L.term (α ⊕ fin n))) (fin_range φ_l) ++ l)).nth ↑i).join = some ⟨_, ts i⟩,
        { intro i,
          simp only [option.join, map_append, map_map, option.bind_eq_some, id.def, exists_eq_right,
            nth_eq_some, length_append, length_map, length_fin_range],
          refine ⟨lt_of_lt_of_le i.2 le_self_add, _⟩,
          rw [nth_le_append, nth_le_map],
          { simp only [sum.get_left, nth_le_fin_range, fin.eta, function.comp_app, eq_self_iff_true,
            heq_iff_eq, and_self] },
          { exact lt_of_lt_of_le i.is_lt (ge_of_eq (length_fin_range _)) },
          { rw [length_map, length_fin_range],
            exact i.2 } },
        rw dif_pos, swap,
        { exact λ i, option.is_some_iff_exists.2 ⟨⟨_, ts i⟩, h i⟩ },
        rw dif_pos, swap,
        { intro i,
          obtain ⟨h1, h2⟩ := option.eq_some_iff_get_eq.1 (h i),
          rw h2 },
        simp only [eq_self_iff_true, heq_iff_eq, true_and],
        refine ⟨funext (λ i, _), _⟩,
        { obtain ⟨h1, h2⟩ := option.eq_some_iff_get_eq.1 (h i),
          rw [eq_mp_eq_cast, cast_eq_iff_heq],
          exact (sigma.ext_iff.1 ((sigma.eta (option.get h1)).trans h2)).2 },
        rw [list.drop_append_eq_append_drop, length_map, length_fin_range, nat.sub_self, drop,
          drop_eq_nil_of_le, nil_append],
        rw [length_map, length_fin_range], }, },
    { rw [list_encode, append_assoc, cons_append, list_decode],
      simp only [subtype.val_eq_coe] at *,
      rw [(ih1 _).1, (ih1 _).2, (ih2 _).1, (ih2 _).2, sigma_imp, dif_pos rfl],
      exact ⟨rfl, rfl⟩, },
    { rw [list_encode, cons_append, list_decode],
      simp only,
      simp only [subtype.val_eq_coe] at *,
      rw [(ih _).1, (ih _).2, sigma_all],
      exact ⟨rfl, rfl⟩ } }
end

/-- An encoding of bounded formulas as lists. -/
@[simps] protected def encoding : encoding (Σ n, L.bounded_formula α n) :=
{ Γ := (Σ k, L.term (α ⊕ fin k)) ⊕ (Σ n, L.relations n) ⊕ ℕ,
  encode := λ φ, φ.2.list_encode,
  decode := λ l, (list_decode l).1,
  decode_encode := λ φ, begin
    have h := list_decode_encode_list [φ],
    rw [bind_singleton] at h,
    rw h,
    refl,
  end }

lemma list_encode_sigma_injective :
  function.injective (λ (φ : Σ n, L.bounded_formula α n), φ.2.list_encode) :=
bounded_formula.encoding.encode_injective

theorem card_le : # (Σ n, L.bounded_formula α n) ≤
  max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card) :=
begin
  refine lift_le.1 ((bounded_formula.encoding.card_le_card_list).trans _),
  rw [encoding_Γ, mk_list_eq_max_mk_aleph_0, lift_max, lift_aleph_0, lift_max, lift_aleph_0,
    max_le_iff],
  refine ⟨_, le_max_left _ _⟩,
  rw [mk_sum, term.card_sigma, mk_sum, ← add_eq_max le_rfl, mk_sum, mk_nat],
  simp only [lift_add, lift_lift, lift_aleph_0],
  rw [← add_assoc, add_comm, ← add_assoc, ← add_assoc, aleph_0_add_aleph_0, add_assoc,
    add_eq_max le_rfl, add_assoc, card, symbols, mk_sum, lift_add, lift_lift, lift_lift],
end

end bounded_formula

end language
end first_order


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

! This file was ported from Lean 3 source module number_theory.zsqrtd.to_real
! leanprover-community/mathlib commit 97eab48559068f3d6313da387714ef25768fb730
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Real.Sqrt
import Mathbin.NumberTheory.Zsqrtd.Basic

/-!
# Image of `zsqrtd` in `ℝ`

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

This file defines `zsqrtd.to_real` and related lemmas.
It is in a separate file to avoid pulling in all of `data.real` into `data.zsqrtd`.
-/

namespace Zsqrtd

#print Zsqrtd.toReal /-
/-- The image of `zsqrtd` in `ℝ`, using `real.sqrt` which takes the positive root of `d`.

If the negative root is desired, use `to_real h a.conj`. -/
@[simps]
noncomputable def toReal {d : ℤ} (h : 0 ≤ d) : ℤ√d →+* ℝ :=
  lift ⟨Real.sqrt d, Real.mul_self_sqrt (Int.cast_nonneg.mpr h)⟩
#align zsqrtd.to_real Zsqrtd.toReal
-/

/- warning: zsqrtd.to_real_injective -> Zsqrtd.toReal_injective is a dubious translation:
lean 3 declaration is
  forall {d : Int} (h0d : LE.le.{0} Int Int.hasLe (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))) d), (forall (n : Int), Ne.{1} Int d (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.hasMul) n n)) -> (Function.Injective.{1, 1} (Zsqrtd d) Real (coeFn.{1, 1} (RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.ring d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.ring))) (fun (_x : RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.ring d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.ring))) => (Zsqrtd d) -> Real) (RingHom.hasCoeToFun.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.ring d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.ring))) (Zsqrtd.toReal d h0d)))
but is expected to have type
  forall {d : Int} (h0d : LE.le.{0} Int Int.instLEInt (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)) d), (forall (n : Int), Ne.{1} Int d (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.instMulInt) n n)) -> (Function.Injective.{1, 1} (Zsqrtd d) Real (FunLike.coe.{1, 1, 1} (RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal))) (Zsqrtd d) (fun (_x : Zsqrtd d) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Zsqrtd d) => Real) _x) (MulHomClass.toFunLike.{0, 0, 0} (RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal))) (Zsqrtd d) Real (NonUnitalNonAssocSemiring.toMul.{0} (Zsqrtd d) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} (Zsqrtd d) (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))))) (NonUnitalNonAssocSemiring.toMul.{0} Real (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} Real (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal)))) (NonUnitalRingHomClass.toMulHomClass.{0, 0, 0} (RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal))) (Zsqrtd d) Real (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} (Zsqrtd d) (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d)))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{0} Real (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal))) (RingHomClass.toNonUnitalRingHomClass.{0, 0, 0} (RingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal))) (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal)) (RingHom.instRingHomClassRingHom.{0, 0} (Zsqrtd d) Real (NonAssocRing.toNonAssocSemiring.{0} (Zsqrtd d) (Ring.toNonAssocRing.{0} (Zsqrtd d) (Zsqrtd.instRingZsqrtd d))) (NonAssocRing.toNonAssocSemiring.{0} Real (Ring.toNonAssocRing.{0} Real Real.instRingReal)))))) (Zsqrtd.toReal d h0d)))
Case conversion may be inaccurate. Consider using '#align zsqrtd.to_real_injective Zsqrtd.toReal_injectiveₓ'. -/
theorem toReal_injective {d : ℤ} (h0d : 0 ≤ d) (hd : ∀ n : ℤ, d ≠ n * n) :
    Function.Injective (toReal h0d) :=
  lift_injective _ hd
#align zsqrtd.to_real_injective Zsqrtd.toReal_injective

end Zsqrtd


import algebra.group
import linear_algebra.tensor_product
import tactic.ring

universes v u

section canonical

variables (R : Type u) [comm_ring R]
variables (A : ℕ → Type v) {m n : ℕ} (h : m = n)
include h

def canonical_map : A m → A n := (congr_arg A h).mp

instance canonical_hom [∀ n, add_comm_group (A n)] : is_add_group_hom (canonical_map A h : A m → A n) :=
begin
  subst h,
  exact is_add_group_hom.id
end

def canonical_R_hom [∀ n, add_comm_group (A n)] [∀ n, module R (A n)] : (A m) →ₗ[R] (A n) :=
begin
  subst h,
  exact linear_map.id
end

end canonical

structure cdga (R : Type u) [comm_ring R] :=
(A : ℕ → Type v) -- universe polymorphism FTW
[hA : ∀ n, add_comm_group (A n)]
[hRA : ∀ n, module R (A n)]
(mul : ∀ i j , (A i) →ₗ[R] (A j) →ₗ[R] (A (i + j)))
(one : A 0)
(one_mul : ∀ {j} (a : A j), canonical_R_hom R A (zero_add j) (mul 0 j one a) = a)
(mul_one : ∀ {j} (a : A j), canonical_R_hom R A (add_zero j) (mul j 0 a one) = a)
(mul_assoc : ∀ {i j k} (a : A i) (b : A j) (c : A k),
   canonical_R_hom R A (add_assoc i j k) (mul (i+j) k (mul i j a b) c) = mul i (j + k) a (mul j k b c))
(graded_comm : ∀ {i j} (a : A i) (b : A j),
  canonical_R_hom R A (add_comm j i) (mul j i b a) = (-1 : R)^(i * j) • mul i j a b)
(d : ∀ n, (A n) →ₗ[R] (A (n + 1)))
(d_squared : ∀ {n} (a : A n), (d (n + 1) : A (n + 1) → A (n + 2)) (d n a) = 0)
(Leibniz : ∀ i j (a : A i) (b : A j), d (i + j) (mul i j a b) =
   canonical_R_hom R A (add_right_comm i (1:ℕ) j) (mul (i+(1:ℕ)) j (d i a) b) +
   (-1 : R) ^ i • canonical_R_hom R A (add_assoc i j (1:ℕ)).symm (mul i (j+(1:ℕ)) a (d j b)))
attribute [instance] cdga.hA cdga.hRA

/-
If AAA is a CDGA then its cohomology H∗(A)H^*(A)H∗(A) is a graded commutative algebra. Basically this amounts to checking that

    if da=0da = 0da=0 and db=0db = 0db=0, then d(a⋅b)=0d(a \cdot b) = 0d(a⋅b)=0
    if da=0da = 0da=0 and b=db′b = db'b=db′, then a⋅ba \cdot ba⋅b is ddd of something (namely (−1)ia⋅b′(-1)^i a \cdot b'(−1)ia⋅b′ where a∈Aia \in A_ia∈Ai),
    similarly if a=da′a = da'a=da′ and db=0db = 0db=0 then a⋅ba \cdot ba⋅b is ddd of something
    and therefore the multiplication Ai×Aj→Ai+jA_i \times A_j \to A_{i+j}Ai×Aj→Ai+j restricts/descends to the kernel of ddd modulo the image of ddd.

-/
namespace cdga

variables (R : Type u) [comm_ring R] (A : cdga R)

lemma zero_mul {i j : ℕ} (b : A.A j) : A.mul i j (0 : A.A i) b = 0 :=
by rw [linear_map.map_zero, linear_map.zero_apply]

lemma mul_zero {i j : ℕ} (a : A.A i) : A.mul i j a (0 : A.A j) = 0 :=
linear_map.map_zero _

--set_option pp.proofs true
lemma ker_d_prod (A : cdga R) {i j : ℕ} (a : A.A i) (b : A.A j) (ha : A.d i a = 0) (hb : A.d j b = 0) :
  A.d (i + j) (A.mul i j a b) = 0 :=
by rw [A.Leibniz, ha, hb, zero_mul, mul_zero, linear_map.map_zero, linear_map.map_zero, zero_add, smul_zero]

end cdga


namespace prop_21
/-
An example of a proof without use of classical rules.
-/

variable A : Prop

theorem prop_21 : ¬ (A ↔ ¬ A) :=
assume h1: A ↔ ¬ A,
have h2: A → (A → false), from h1.mp,
have h3: (A → false) → A, from h1.mpr,
have h4: A → false, from (assume h5: A, (h2 h5) h5),
have h6: A, from h3 h4,
show false, from h4 h6

/-
No classical logic used so should print `no axioms`.
-/
#print axioms prop_21

-- end namespace
end prop_21


/-
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 data.mv_polynomial.variables

/-!
# Multivariate polynomials over a ring

Many results about polynomials hold when the coefficient ring is a commutative semiring.
Some stronger results can be derived when we assume this semiring is a ring.

This file does not define any new operations, but proves some of these stronger results.

## Notation

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

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

+ `R : Type*` `[comm_ring 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`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u v
variables {R : Type u} {S : Type v}

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section comm_ring
variable [comm_ring R]
variables {p q : mv_polynomial σ R}

instance : comm_ring (mv_polynomial σ R) := add_monoid_algebra.comm_ring

variables (σ a a')

@[simp] lemma C_sub : (C (a - a') : mv_polynomial σ R) = C a - C a' := ring_hom.map_sub _ _ _

@[simp] lemma C_neg : (C (-a) : mv_polynomial σ R) = -C a := ring_hom.map_neg _ _

@[simp] lemma coeff_neg (m : σ →₀ ℕ) (p : mv_polynomial σ R) :
  coeff m (-p) = -coeff m p := finsupp.neg_apply _ _

@[simp] lemma coeff_sub (m : σ →₀ ℕ) (p q : mv_polynomial σ R) :
  coeff m (p - q) = coeff m p - coeff m q := finsupp.sub_apply _ _ _

@[simp] lemma support_neg : (- p).support = p.support :=
finsupp.support_neg

variables {σ} (p)

section degrees

lemma degrees_neg (p : mv_polynomial σ R) : (- p).degrees = p.degrees :=
by rw [degrees, support_neg]; refl

lemma degrees_sub (p q : mv_polynomial σ R) :
  (p - q).degrees ≤ p.degrees ⊔ q.degrees :=
by simpa only [sub_eq_add_neg] using le_trans (degrees_add p (-q)) (by rw degrees_neg)

end degrees

section vars

variables (p q)

@[simp] lemma vars_neg : (-p).vars = p.vars :=
by simp [vars, degrees_neg]

lemma vars_sub_subset : (p - q).vars ⊆ p.vars ∪ q.vars :=
by convert vars_add_subset p (-q) using 2; simp [sub_eq_add_neg]

variables {p q}

@[simp]
lemma vars_sub_of_disjoint (hpq : disjoint p.vars q.vars) : (p - q).vars = p.vars ∪ q.vars :=
begin
  rw ←vars_neg q at hpq,
  convert vars_add_of_disjoint hpq using 2;
    simp [sub_eq_add_neg]
end

end vars

section eval₂

variables [comm_ring S]
variables (f : R →+* S) (g : σ → S)

@[simp]

@[simp] lemma eval₂_neg : (-p).eval₂ f g = -(p.eval₂ f g) := (eval₂_hom f g).map_neg _

lemma hom_C (f : mv_polynomial σ ℤ →+* S) (n : ℤ) : f (C n) = (n : S) :=
(f.comp C).eq_int_cast n

/-- A ring homomorphism f : Z[X_1, X_2, ...] → R
is determined by the evaluations f(X_1), f(X_2), ... -/
@[simp] lemma eval₂_hom_X {R : Type u} (c : ℤ →+* S)
  (f : mv_polynomial R ℤ →+* S) (x : mv_polynomial R ℤ) :
  eval₂ c (f ∘ X) x = f x :=
mv_polynomial.induction_on x
(λ n, by { rw [hom_C f, eval₂_C], exact c.eq_int_cast n })
(λ p q hp hq, by { rw [eval₂_add, hp, hq], exact (f.map_add _ _).symm })
(λ p n hp, by { rw [eval₂_mul, eval₂_X, hp], exact (f.map_mul _ _).symm })

/-- Ring homomorphisms out of integer polynomials on a type `σ` are the same as
functions out of the type `σ`, -/
def hom_equiv : (mv_polynomial σ ℤ →+* S) ≃ (σ → S) :=
{ to_fun := λ f, ⇑f ∘ X,
  inv_fun := λ f, eval₂_hom (int.cast_ring_hom S) f,
  left_inv := λ f, ring_hom.ext  $ eval₂_hom_X _ _,
  right_inv := λ f, funext $ λ x, by simp only [coe_eval₂_hom, function.comp_app, eval₂_X] }

end eval₂

section total_degree

@[simp] lemma total_degree_neg (a : mv_polynomial σ R) :
  (-a).total_degree = a.total_degree :=
by simp only [total_degree, support_neg]

lemma total_degree_sub (a b : mv_polynomial σ R) :
  (a - b).total_degree ≤ max a.total_degree b.total_degree :=
calc (a - b).total_degree = (a + -b).total_degree                : by rw sub_eq_add_neg
                      ... ≤ max a.total_degree (-b).total_degree : total_degree_add a (-b)
                      ... = max a.total_degree b.total_degree    : by rw total_degree_neg

end total_degree

end comm_ring

end mv_polynomial


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

import data.multiset.basic
import data.vector2
import tactic.tidy

/-!
# Symmetric powers

This file defines symmetric powers of a type.  The nth symmetric power
consists of homogeneous n-tuples modulo permutations by the symmetric
group.

The special case of 2-tuples is called the symmetric square, which is
addressed in more detail in `data.sym2`.

TODO: This was created as supporting material for `data.sym2`; it
needs a fleshed-out interface.

## Tags

symmetric powers

-/

universes u

/--
The nth symmetric power is n-tuples up to permutation.  We define it
as a subtype of `multiset` since these are well developed in the
library.  We also give a definition `sym.sym'` in terms of vectors, and we
show these are equivalent in `sym.sym_equiv_sym'`.
-/
def sym (α : Type u) (n : ℕ) := {s : multiset α // s.card = n}

/--
This is the `list.perm` setoid lifted to `vector`.
-/
def vector.perm.is_setoid (α : Type u) (n : ℕ) : setoid (vector α n) :=
{ r := λ a b, list.perm a.1 b.1,
  iseqv := by { rcases list.perm.eqv α with ⟨hr, hs, ht⟩, tidy, } }

local attribute [instance] vector.perm.is_setoid

namespace sym

variables {α : Type u} {n : ℕ}

/--
This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
def of_vector (x : vector α n) : sym α n :=
⟨↑x.val, by { rw multiset.coe_card, exact x.2 }⟩

instance : has_lift (vector α n) (sym α n) :=
{ lift := of_vector }

/--
The unique element in `sym α 0`.
-/
@[pattern] def nil : sym α 0 := ⟨0, by tidy⟩

/--
Inserts an element into the term of `sym α n`, increasing the length by one.
-/
@[pattern] def cons : α → sym α n → sym α (nat.succ n)
| a ⟨s, h⟩ := ⟨a ::ₘ s, by rw [multiset.card_cons, h]⟩

notation a :: b := cons a b

@[simp]
lemma cons_inj_right (a : α) (s s' : sym α n) : a :: s = a :: s' ↔ s = s' :=
by { cases s, cases s', delta cons, simp, }

@[simp]
lemma cons_inj_left (a a' : α) (s : sym α n) : a :: s = a' :: s ↔ a = a' :=
by { cases s, delta cons, simp, }

lemma cons_swap (a b : α) (s : sym α n) : a :: b :: s = b :: a :: s :=
by { cases s, ext, delta cons, rw subtype.coe_mk, dsimp, exact multiset.cons_swap a b s_val }

/--
`α ∈ s` means that `a` appears as one of the factors in `s`.
-/
def mem (a : α) (s : sym α n) : Prop := a ∈ s.1

instance : has_mem α (sym α n) := ⟨mem⟩

instance decidable_mem [decidable_eq α] (a : α) (s : sym α n) : decidable (a ∈ s) :=
by { cases s, change decidable (a ∈ s_val), apply_instance }

@[simp] lemma mem_cons {a b : α} {s : sym α n} : a ∈ b :: s ↔ a = b ∨ a ∈ s :=
begin cases s, change a ∈ b ::ₘ s_val ↔ a = b ∨ a ∈ s_val, simp, end

lemma mem_cons_of_mem {a b : α} {s : sym α n} (h : a ∈ s) : a ∈ b :: s :=
mem_cons.2 (or.inr h)

@[simp] lemma mem_cons_self (a : α) (s : sym α n) : a ∈ a :: s :=
mem_cons.2 (or.inl rfl)

lemma cons_of_coe_eq (a : α) (v : vector α n) : a :: (↑v : sym α n) = ↑(a ::ᵥ v) :=
by { unfold_coes, delta of_vector, delta cons, delta vector.cons, tidy }

lemma sound {a b : vector α n} (h : a.val ~ b.val) : (↑a : sym α n) = ↑b :=
begin
  cases a, cases b, unfold_coes, dunfold of_vector,
  simp only [subtype.mk_eq_mk, multiset.coe_eq_coe],
  exact h,
end

/--
Another definition of the nth symmetric power, using vectors modulo permutations. (See `sym`.)
-/
def sym' (α : Type u) (n : ℕ) := quotient (vector.perm.is_setoid α n)

/--
This is `cons` but for the alternative `sym'` definition.
-/
def cons' {α : Type u} {n : ℕ} : α → sym' α n → sym' α (nat.succ n) :=
λ a, quotient.map (vector.cons a) (λ ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ h, list.perm.cons _ h)

notation a :: b := cons' a b

/--
Multisets of cardinality n are equivalent to length-n vectors up to permutations.
-/
def sym_equiv_sym' {α : Type u} {n : ℕ} : sym α n ≃ sym' α n :=
equiv.subtype_quotient_equiv_quotient_subtype _ _ (λ _, by refl) (λ _ _, by refl)

lemma cons_equiv_eq_equiv_cons (α : Type u) (n : ℕ) (a : α) (s : sym α n) :
  a :: sym_equiv_sym' s = sym_equiv_sym' (a :: s) :=
by tidy

section inhabited
-- Instances to make the linter happy

instance inhabited_sym [inhabited α] (n : ℕ) : inhabited (sym α n) :=
⟨⟨multiset.repeat (default α) n, multiset.card_repeat _ _⟩⟩

instance inhabited_sym' [inhabited α] (n : ℕ) : inhabited (sym' α n) :=
⟨quotient.mk' (vector.repeat (default α) n)⟩

end inhabited

end sym


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import tactic.basic
import logic.is_empty

/-!
# Types with a unique term

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

In this file we define a typeclass `unique`,
which expresses that a type has a unique term.
In other words, a type that is `inhabited` and a `subsingleton`.

## Main declaration

* `unique`: a typeclass that expresses that a type has a unique term.

## Main statements

* `unique.mk'`: an inhabited subsingleton type is `unique`. This can not be an instance because it
  would lead to loops in typeclass inference.

* `function.surjective.unique`: if the domain of a surjective function is `unique`, then its
  codomain is `unique` as well.

* `function.injective.subsingleton`: if the codomain of an injective function is `subsingleton`,
  then its domain is `subsingleton` as well.

* `function.injective.unique`: if the codomain of an injective function is `subsingleton` and its
  domain is `inhabited`, then its domain is `unique`.

## Implementation details

The typeclass `unique α` is implemented as a type,
rather than a `Prop`-valued predicate,
for good definitional properties of the default term.

-/

universes u v w

variables {α : Sort u} {β : Sort v} {γ : Sort w}

/-- `unique α` expresses that `α` is a type with a unique term `default`.

This is implemented as a type, rather than a `Prop`-valued predicate,
for good definitional properties of the default term. -/
@[ext]
structure unique (α : Sort u) extends inhabited α :=
(uniq : ∀ a : α, a = default)

attribute [class] unique

lemma unique_iff_exists_unique (α : Sort u) : nonempty (unique α) ↔ ∃! a : α, true :=
⟨λ ⟨u⟩, ⟨u.default, trivial, λ a _, u.uniq a⟩, λ ⟨a,_,h⟩, ⟨⟨⟨a⟩, λ _, h _ trivial⟩⟩⟩

lemma unique_subtype_iff_exists_unique {α} (p : α → Prop) :
  nonempty (unique (subtype p)) ↔ ∃! a, p a :=
⟨λ ⟨u⟩, ⟨u.default.1, u.default.2, λ a h, congr_arg subtype.val (u.uniq ⟨a,h⟩)⟩,
 λ ⟨a,ha,he⟩, ⟨⟨⟨⟨a,ha⟩⟩, λ ⟨b,hb⟩, by { congr, exact he b hb }⟩⟩⟩

/-- Given an explicit `a : α` with `[subsingleton α]`, we can construct
a `[unique α]` instance. This is a def because the typeclass search cannot
arbitrarily invent the `a : α` term. Nevertheless, these instances are all
equivalent by `unique.subsingleton.unique`.

See note [reducible non-instances]. -/
@[reducible] def unique_of_subsingleton {α : Sort*} [subsingleton α] (a : α) : unique α :=
{ default := a,
  uniq := λ _, subsingleton.elim _ _ }

instance punit.unique : unique punit.{u} :=
{ default := punit.star,
  uniq := λ x, punit_eq x _ }

@[simp] lemma punit.default_eq_star : (default : punit) = punit.star := rfl

/-- Every provable proposition is unique, as all proofs are equal. -/
def unique_prop {p : Prop} (h : p) : unique p :=
{ default := h, uniq := λ x, rfl }

instance : unique true := unique_prop trivial

lemma fin.eq_zero : ∀ n : fin 1, n = 0
| ⟨n, hn⟩ := fin.eq_of_veq (nat.eq_zero_of_le_zero (nat.le_of_lt_succ hn))

instance {n : ℕ} : inhabited (fin n.succ) := ⟨0⟩
instance inhabited_fin_one_add (n : ℕ) : inhabited (fin (1 + n)) := ⟨⟨0, nat.zero_lt_one_add n⟩⟩

@[simp] lemma fin.default_eq_zero (n : ℕ) : (default : fin n.succ) = 0 := rfl

instance fin.unique : unique (fin 1) :=
{ uniq := fin.eq_zero, .. fin.inhabited }

namespace unique
open function

section

variables [unique α]

@[priority 100] -- see Note [lower instance priority]
instance : inhabited α := to_inhabited ‹unique α›

lemma eq_default (a : α) : a = default := uniq _ a

lemma default_eq (a : α) : default = a := (uniq _ a).symm

@[priority 100] -- see Note [lower instance priority]
instance : subsingleton α := subsingleton_of_forall_eq _ eq_default

lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ p default :=
⟨λ h, h _, λ h x, by rwa [unique.eq_default x]⟩

lemma exists_iff {p : α → Prop} : Exists p ↔ p default :=
⟨λ ⟨a, ha⟩, eq_default a ▸ ha, exists.intro default⟩

end

@[ext] protected lemma subsingleton_unique' : ∀ (h₁ h₂ : unique α), h₁ = h₂
| ⟨⟨x⟩, h⟩ ⟨⟨y⟩, _⟩ := by congr; rw [h x, h y]

instance subsingleton_unique : subsingleton (unique α) :=
⟨unique.subsingleton_unique'⟩

/-- Construct `unique` from `inhabited` and `subsingleton`. Making this an instance would create
a loop in the class inheritance graph. -/
@[reducible] def mk' (α : Sort u) [h₁ : inhabited α] [subsingleton α] : unique α :=
{ uniq := λ x, subsingleton.elim _ _, .. h₁ }

end unique

lemma unique_iff_subsingleton_and_nonempty (α : Sort u) :
  nonempty (unique α) ↔ subsingleton α ∧ nonempty α :=
⟨λ ⟨u⟩, by split; exactI infer_instance,
 λ ⟨hs, hn⟩, ⟨by { resetI, inhabit α, exact unique.mk' α }⟩⟩

@[simp] lemma pi.default_def {β : α → Sort v} [Π a, inhabited (β a)] :
  @default (Π a, β a) _ = λ a : α, @default (β a) _ := rfl

lemma pi.default_apply {β : α → Sort v} [Π a, inhabited (β a)] (a : α) :
  @default (Π a, β a) _ a = default := rfl

instance pi.unique {β : α → Sort v} [Π a, unique (β a)] : unique (Π a, β a) :=
{ uniq := λ f, funext $ λ x, unique.eq_default _,
  .. pi.inhabited α }

/-- There is a unique function on an empty domain. -/
instance pi.unique_of_is_empty [is_empty α] (β : α → Sort v) :
  unique (Π a, β a) :=
{ default := is_empty_elim,
  uniq := λ f, funext is_empty_elim }

lemma eq_const_of_unique [unique α] (f : α → β) : f = function.const α (f default) :=
by { ext x, rw subsingleton.elim x default }

lemma heq_const_of_unique [unique α] {β : α → Sort v}
  (f : Π a, β a) : f == function.const α (f default) :=
function.hfunext rfl $ λ i _ _, by rw subsingleton.elim i default

namespace function

variable {f : α → β}

/-- If the codomain of an injective function is a subsingleton, then the domain
is a subsingleton as well. -/
protected lemma injective.subsingleton (hf : injective f) [subsingleton β] :
  subsingleton α :=
⟨λ x y, hf $ subsingleton.elim _ _⟩

/-- If the domain of a surjective function is a subsingleton, then the codomain is a subsingleton as
well. -/
protected lemma surjective.subsingleton [subsingleton α] (hf : surjective f) :
  subsingleton β :=
⟨hf.forall₂.2 $ λ x y, congr_arg f $ subsingleton.elim x y⟩

/-- If the domain of a surjective function is a singleton,
then the codomain is a singleton as well. -/
protected def surjective.unique (hf : surjective f) [unique α] : unique β :=
@unique.mk' _ ⟨f default⟩ hf.subsingleton

/-- If `α` is inhabited and admits an injective map to a subsingleton type, then `α` is `unique`. -/
protected def injective.unique [inhabited α] [subsingleton β] (hf : injective f) : unique α :=
@unique.mk' _ _ hf.subsingleton

/-- If a constant function is surjective, then the codomain is a singleton. -/
def surjective.unique_of_surjective_const (α : Type*) {β : Type*} (b : β)
  (h : function.surjective (function.const α b)) : unique β :=
@unique_of_subsingleton _ (subsingleton_of_forall_eq b $ h.forall.mpr (λ _, rfl)) b

end function

lemma unique.bijective {A B} [unique A] [unique B] {f : A → B} : function.bijective f :=
begin
  rw function.bijective_iff_has_inverse,
  refine ⟨default, _, _⟩; intro x; simp
end

namespace option

/-- `option α` is a `subsingleton` if and only if `α` is empty. -/
lemma subsingleton_iff_is_empty {α} : subsingleton (option α) ↔ is_empty α :=
⟨λ h, ⟨λ x, option.no_confusion $ @subsingleton.elim _ h x none⟩,
  λ h, ⟨λ x y, option.cases_on x (option.cases_on y rfl (λ x, h.elim x)) (λ x, h.elim x)⟩⟩

instance {α} [is_empty α] : unique (option α) := @unique.mk' _ _ (subsingleton_iff_is_empty.2 ‹_›)

end option

section subtype

instance unique.subtype_eq (y : α) : unique {x // x = y} :=
{ default := ⟨y, rfl⟩,
  uniq := λ ⟨x, hx⟩, by simpa using hx }

instance unique.subtype_eq' (y : α) : unique {x // y = x} :=
{ default := ⟨y, rfl⟩,
  uniq := λ ⟨x, hx⟩, by simpa using hx.symm }

end subtype


-- import the definitions of uniform space via covers
import uniform_structure.covers

-- import the definition of pseudometric space
import pseudometric_space

-- In this exercise we will show that a pseudometric on a set X
-- gives rise to a distinguished family of covers for X
-- which make X into a "uniform space in the sense of covers"

-- This is a question about pseudometrics so let's put it
-- in the pseudometric namespace

namespace pseudometric

-- Let X be a set (or a type), and let d be a pseudometric on X
variables {X : Type} (d : X → X → ℝ) [is_pseudometric d]

-- let's define a closed ball

/-- Closed ball centre x radius ε -/
def closed_ball (x : X) (ε : ℝ) := {y : X | d x y ≤ ε}

-- definition of closed ball
lemma mem_closed_ball {x y : X} {ε : ℝ} : y ∈ closed_ball d x ε ↔ d x y ≤ ε :=
iff.rfl -- true by definition

-- Here's an obvious lemma: if 0 ≤ ε then x is in the closed ball centre x
-- and radius ε

-- But do we need it?

-- lemma self_mem_ball (x : X) (ε : ℝ) (hε : 0 ≤ ε) : x ∈ closed_ball d x ε :=
-- begin
--   rw mem_closed_ball,
--   rw d_self d,
--   assumption
-- end

-- Define Θ to be the set of covers of X with the following property:
-- there exists ε ≥ 0 such that each set in the cover contains a closed ball
-- of radius ε (note that ε is independent of which set in the cover)

def Θ : set (cover X) :=
  {𝒞 | ∃ ε (hε : 0 < ε), ∀ x : X, ∃ U ∈ 𝒞.C, closed_ball d x ε ⊆ U}

-- a cover is in Θ iff it's a closed ball cover, or the universal cover
-- the proof is obvious
lemma mem_Θ (𝒞 : cover X) : 𝒞 ∈ Θ d ↔
  ∃ ε (hε : 0 < ε), ∀ x : X, ∃ U ∈ 𝒞.C, closed_ball d x ε ⊆ U := iff.rfl -- true by definition

-- The exerise is to show that the 3 axioms for a distinguished family are
-- satisfied by Θ

-- Axiom 1: the universal cover is in
lemma univ_mem : univ_cover X ∈ Θ d :=
begin
  sorry
end

-- Axiom 2 : anything star-bigger than a distinguished cover is distinguished
lemma star_mem (P Q : cover X) (hP : P ∈ Θ d) (hPQ : P <* Q) : Q ∈ Θ d :=
begin
  sorry
end

-- Axiom 3: two covers have an upper bound in the <* ordering
lemma ub_mem (P Q : cover X) (hP : P ∈ Θ d) (hQ : Q ∈ Θ d) :
  ∃ R : cover X, R ∈ Θ d ∧ R <* P ∧ R <* Q :=
begin
  sorry
end

definition to_cover : dist_covers X :=
{ Θ := Θ d,
  univ_mem := univ_mem d,
  star_mem := star_mem d,
  ub_mem := ub_mem d}

end pseudometric


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Patrick Stevens
-/
import data.nat.choose.basic
import data.nat.prime
import data.rat.floor
/-!
# Divisibility properties of binomial coefficients
-/

namespace nat

open_locale nat

namespace prime

lemma dvd_choose_add {p a b : ℕ} (hap : a < p) (hbp : b < p) (h : p ≤ a + b)
  (hp : prime p) : p ∣ choose (a + b) a :=
have h₁ : p ∣ (a + b)!, from hp.dvd_factorial.2 h,
have h₂ : ¬p ∣ a!, from mt hp.dvd_factorial.1 (not_le_of_gt hap),
have h₃ : ¬p ∣ b!, from mt hp.dvd_factorial.1 (not_le_of_gt hbp),
by
  rw [← choose_mul_factorial_mul_factorial (le.intro rfl), mul_assoc, hp.dvd_mul, hp.dvd_mul,
      nat.add_sub_cancel_left a b] at h₁;
  exact h₁.resolve_right (not_or_distrib.2 ⟨h₂, h₃⟩)

lemma dvd_choose_self {p k : ℕ} (hk : 0 < k) (hkp : k < p) (hp : prime p) :
  p ∣ choose p k :=
begin
  have r : k + (p - k) = p,
    by rw [← nat.add_sub_assoc (nat.le_of_lt hkp) k, nat.add_sub_cancel_left],
  have e : p ∣ choose (k + (p - k)) k,
    by exact dvd_choose_add hkp (sub_lt (hk.trans hkp) hk) (by rw r) hp,
  rwa r at e,
end

end prime

lemma choose_eq_factorial_div_factorial' {a b : ℕ}
  (hab : a ≤ b) : (b.choose a : ℚ) = b! / (a! * (b - a)!) :=
begin
  field_simp [mul_ne_zero, factorial_ne_zero], norm_cast,
  rw ← choose_mul_factorial_mul_factorial hab, ring,
end

lemma choose_mul {n k s : ℕ} (hn : k ≤ n) (hs : s ≤ k) :
  (n.choose k : ℚ) * k.choose s = n.choose s * (n - s).choose (k - s) :=
begin
  rw [choose_eq_factorial_div_factorial' hn, choose_eq_factorial_div_factorial' hs,
      choose_eq_factorial_div_factorial' (le_trans hs hn), choose_eq_factorial_div_factorial' ],
  swap,
  { exact nat.sub_le_sub_right hn s, },
  { field_simp [mul_ne_zero, factorial_ne_zero],
    rw sub_sub_sub_cancel_right hs, ring, },
end

end nat