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

! This file was ported from Lean 3 source module combinatorics.simple_graph.degree_sum
! 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.Combinatorics.SimpleGraph.Basic
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Data.Nat.Parity
import Mathbin.Data.Zmod.Parity

/-!
# Degree-sum formula and handshaking lemma

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

The degree-sum formula is that the sum of the degrees of the vertices in
a finite graph is equal to twice the number of edges.  The handshaking lemma,
a corollary, is that the number of odd-degree vertices is even.

## Main definitions

- `simple_graph.sum_degrees_eq_twice_card_edges` is the degree-sum formula.
- `simple_graph.even_card_odd_degree_vertices` is the handshaking lemma.
- `simple_graph.odd_card_odd_degree_vertices_ne` is that the number of odd-degree
  vertices different from a given odd-degree vertex is odd.
- `simple_graph.exists_ne_odd_degree_of_exists_odd_degree` is that the existence of an
  odd-degree vertex implies the existence of another one.

## Implementation notes

We give a combinatorial proof by using the facts that (1) the map from
darts to vertices is such that each fiber has cardinality the degree
of the corresponding vertex and that (2) the map from darts to edges is 2-to-1.

## Tags

simple graphs, sums, degree-sum formula, handshaking lemma
-/

open Finset

open BigOperators

namespace SimpleGraph

universe u

variable {V : Type u} (G : SimpleGraph V)

section DegreeSum

variable [Fintype V] [DecidableRel G.Adj]

#print SimpleGraph.dart_fst_fiber /-
theorem dart_fst_fiber [DecidableEq V] (v : V) :
    (univ.filterₓ fun d : G.Dart => d.fst = v) = univ.image (G.dartOfNeighborSet v) :=
  by
  ext d
  simp only [mem_image, true_and_iff, mem_filter, SetCoe.exists, mem_univ, exists_prop_of_true]
  constructor
  · rintro rfl
    exact ⟨_, d.is_adj, by ext <;> rfl⟩
  · rintro ⟨e, he, rfl⟩
    rfl
#align simple_graph.dart_fst_fiber SimpleGraph.dart_fst_fiber
-/

#print SimpleGraph.dart_fst_fiber_card_eq_degree /-
theorem dart_fst_fiber_card_eq_degree [DecidableEq V] (v : V) :
    (univ.filterₓ fun d : G.Dart => d.fst = v).card = G.degree v := by
  simpa only [dart_fst_fiber, Finset.card_univ, card_neighbor_set_eq_degree] using
    card_image_of_injective univ (G.dart_of_neighbor_set_injective v)
#align simple_graph.dart_fst_fiber_card_eq_degree SimpleGraph.dart_fst_fiber_card_eq_degree
-/

#print SimpleGraph.dart_card_eq_sum_degrees /-
theorem dart_card_eq_sum_degrees : Fintype.card G.Dart = ∑ v, G.degree v :=
  by
  haveI := Classical.decEq V
  simp only [← card_univ, ← dart_fst_fiber_card_eq_degree]
  exact card_eq_sum_card_fiberwise (by simp)
#align simple_graph.dart_card_eq_sum_degrees SimpleGraph.dart_card_eq_sum_degrees
-/

variable {G} [DecidableEq V]

#print SimpleGraph.Dart.edge_fiber /-
theorem Dart.edge_fiber (d : G.Dart) :
    (univ.filterₓ fun d' : G.Dart => d'.edge = d.edge) = {d, d.symm} :=
  Finset.ext fun d' => by simpa using dart_edge_eq_iff d' d
#align simple_graph.dart.edge_fiber SimpleGraph.Dart.edge_fiber
-/

variable (G)

/- warning: simple_graph.dart_edge_fiber_card -> SimpleGraph.dart_edge_fiber_card is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : DecidableEq.{succ u1} V] (e : Sym2.{u1} V), (Membership.Mem.{u1, u1} (Sym2.{u1} V) (Set.{u1} (Sym2.{u1} V)) (Set.hasMem.{u1} (Sym2.{u1} V)) e (coeFn.{succ u1, succ u1} (OrderEmbedding.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (SimpleGraph.hasLe.{u1} V) (Set.hasLe.{u1} (Sym2.{u1} V))) (fun (_x : RelEmbedding.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (LE.le.{u1} (SimpleGraph.{u1} V) (SimpleGraph.hasLe.{u1} V)) (LE.le.{u1} (Set.{u1} (Sym2.{u1} V)) (Set.hasLe.{u1} (Sym2.{u1} V)))) => (SimpleGraph.{u1} V) -> (Set.{u1} (Sym2.{u1} V))) (RelEmbedding.hasCoeToFun.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (LE.le.{u1} (SimpleGraph.{u1} V) (SimpleGraph.hasLe.{u1} V)) (LE.le.{u1} (Set.{u1} (Sym2.{u1} V)) (Set.hasLe.{u1} (Sym2.{u1} V)))) (SimpleGraph.edgeSetEmbedding.{u1} V) G)) -> (Eq.{1} Nat (Finset.card.{u1} (SimpleGraph.Dart.{u1} V G) (Finset.filter.{u1} (SimpleGraph.Dart.{u1} V G) (fun (d : SimpleGraph.Dart.{u1} V G) => Eq.{succ u1} (Sym2.{u1} V) (SimpleGraph.Dart.edge.{u1} V G d) e) (fun (a : SimpleGraph.Dart.{u1} V G) => Quotient.decidableEq.{succ u1} (Prod.{u1, u1} V V) (Sym2.Rel.setoid.{u1} V) (fun (a : Prod.{u1, u1} V V) (b : Prod.{u1, u1} V V) => Sym2.Rel.decidableRel.{u1} V (fun (a : V) (b : V) => _inst_3 a b) a b) (SimpleGraph.Dart.edge.{u1} V G a) e) (Finset.univ.{u1} (SimpleGraph.Dart.{u1} V G) (SimpleGraph.Dart.fintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b))))) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))
but is expected to have type
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : DecidableEq.{succ u1} V] (e : Sym2.{u1} V), (Membership.mem.{u1, u1} (Sym2.{u1} V) (Set.{u1} (Sym2.{u1} V)) (Set.instMembershipSet.{u1} (Sym2.{u1} V)) e (SimpleGraph.edgeSet.{u1} V G)) -> (Eq.{1} Nat (Finset.card.{u1} (SimpleGraph.Dart.{u1} V G) (Finset.filter.{u1} (SimpleGraph.Dart.{u1} V G) (fun (d : SimpleGraph.Dart.{u1} V G) => Eq.{succ u1} (Sym2.{u1} V) (SimpleGraph.Dart.edge.{u1} V G d) e) (fun (a : SimpleGraph.Dart.{u1} V G) => Quotient.decidableEq.{succ u1} (Prod.{u1, u1} V V) (Sym2.Rel.setoid.{u1} V) (fun (a : Prod.{u1, u1} V V) (b : Prod.{u1, u1} V V) => (fun (a : Prod.{u1, u1} V V) (b : Prod.{u1, u1} V V) => Sym2.instRelDecidable'.{u1} V (fun (a : V) (b : V) => _inst_3 a b) a b) a b) (SimpleGraph.Dart.edge.{u1} V G a) e) (Finset.univ.{u1} (SimpleGraph.Dart.{u1} V G) (SimpleGraph.Dart.fintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b))))) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))
Case conversion may be inaccurate. Consider using '#align simple_graph.dart_edge_fiber_card SimpleGraph.dart_edge_fiber_cardₓ'. -/
theorem dart_edge_fiber_card (e : Sym2 V) (h : e ∈ G.edgeSetEmbedding) :
    (univ.filterₓ fun d : G.Dart => d.edge = e).card = 2 :=
  by
  refine' Sym2.ind (fun v w h => _) e h
  let d : G.dart := ⟨(v, w), h⟩
  convert congr_arg card d.edge_fiber
  rw [card_insert_of_not_mem, card_singleton]
  rw [mem_singleton]
  exact d.symm_ne.symm
#align simple_graph.dart_edge_fiber_card SimpleGraph.dart_edge_fiber_card

/- warning: simple_graph.dart_card_eq_twice_card_edges -> SimpleGraph.dart_card_eq_twice_card_edges is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : DecidableEq.{succ u1} V], Eq.{1} Nat (Fintype.card.{u1} (SimpleGraph.Dart.{u1} V G) (SimpleGraph.Dart.fintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))) (Finset.card.{u1} (Sym2.{u1} V) (SimpleGraph.edgeFinset.{u1} V G (SimpleGraph.fintypeEdgeSet.{u1} V G (fun (a : V) (b : V) => _inst_3 a b) _inst_1 (fun (a : V) (b : V) => _inst_2 a b)))))
but is expected to have type
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : Fintype.{u1} (Sym2.{u1} V)] [inst._@.Mathlib.Combinatorics.SimpleGraph.DegreeSum._hyg.684 : DecidableEq.{succ u1} V], Eq.{1} Nat (Fintype.card.{u1} (SimpleGraph.Dart.{u1} V G) (SimpleGraph.Dart.fintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (Finset.card.{u1} (Sym2.{u1} V) (SimpleGraph.edgeFinset.{u1} V G (SimpleGraph.fintypeEdgeSet.{u1} V G _inst_3 (fun (a : V) (b : V) => _inst_2 a b)))))
Case conversion may be inaccurate. Consider using '#align simple_graph.dart_card_eq_twice_card_edges SimpleGraph.dart_card_eq_twice_card_edgesₓ'. -/
theorem dart_card_eq_twice_card_edges : Fintype.card G.Dart = 2 * G.edgeFinset.card :=
  by
  rw [← card_univ]
  rw [@card_eq_sum_card_fiberwise _ _ _ dart.edge _ G.edge_finset fun d h =>
      by
      rw [mem_edge_finset]
      apply dart.edge_mem]
  rw [← mul_comm, sum_const_nat]
  intro e h
  apply G.dart_edge_fiber_card e
  rwa [← mem_edge_finset]
#align simple_graph.dart_card_eq_twice_card_edges SimpleGraph.dart_card_eq_twice_card_edges

/- warning: simple_graph.sum_degrees_eq_twice_card_edges -> SimpleGraph.sum_degrees_eq_twice_card_edges is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : DecidableEq.{succ u1} V], Eq.{1} Nat (Finset.sum.{0, u1} Nat V Nat.addCommMonoid (Finset.univ.{u1} V _inst_1) (fun (v : V) => SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) v))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))) (Finset.card.{u1} (Sym2.{u1} V) (SimpleGraph.edgeFinset.{u1} V G (SimpleGraph.fintypeEdgeSet.{u1} V G (fun (a : V) (b : V) => _inst_3 a b) _inst_1 (fun (a : V) (b : V) => _inst_2 a b)))))
but is expected to have type
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] [_inst_3 : Fintype.{u1} (Sym2.{u1} V)] [inst._@.Mathlib.Combinatorics.SimpleGraph.DegreeSum._hyg.883 : DecidableEq.{succ u1} V], Eq.{1} Nat (Finset.sum.{0, u1} Nat V Nat.addCommMonoid (Finset.univ.{u1} V _inst_1) (fun (v : V) => SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) v))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (Finset.card.{u1} (Sym2.{u1} V) (SimpleGraph.edgeFinset.{u1} V G (SimpleGraph.fintypeEdgeSet.{u1} V G _inst_3 (fun (a : V) (b : V) => _inst_2 a b)))))
Case conversion may be inaccurate. Consider using '#align simple_graph.sum_degrees_eq_twice_card_edges SimpleGraph.sum_degrees_eq_twice_card_edgesₓ'. -/
/-- The degree-sum formula.  This is also known as the handshaking lemma, which might
more specifically refer to `simple_graph.even_card_odd_degree_vertices`. -/
theorem sum_degrees_eq_twice_card_edges : (∑ v, G.degree v) = 2 * G.edgeFinset.card :=
  G.dart_card_eq_sum_degrees.symm.trans G.dart_card_eq_twice_card_edges
#align simple_graph.sum_degrees_eq_twice_card_edges SimpleGraph.sum_degrees_eq_twice_card_edges

end DegreeSum

/- warning: simple_graph.even_card_odd_degree_vertices -> SimpleGraph.even_card_odd_degree_vertices is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)], Even.{0} Nat Nat.hasAdd (Finset.card.{u1} V (Finset.filter.{u1} V (fun (v : V) => Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) v))) (fun (a : V) => Nat.Odd.decidablePred (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) a))) (Finset.univ.{u1} V _inst_1)))
but is expected to have type
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)], Even.{0} Nat instAddNat (Finset.card.{u1} V (Finset.filter.{u1} V (fun (v : V) => Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) v))) (fun (a : V) => Nat.instDecidablePredNatOddSemiring (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_2 a b) a))) (Finset.univ.{u1} V _inst_1)))
Case conversion may be inaccurate. Consider using '#align simple_graph.even_card_odd_degree_vertices SimpleGraph.even_card_odd_degree_verticesₓ'. -/
/-- The handshaking lemma.  See also `simple_graph.sum_degrees_eq_twice_card_edges`. -/
theorem even_card_odd_degree_vertices [Fintype V] [DecidableRel G.Adj] :
    Even (univ.filterₓ fun v => Odd (G.degree v)).card := by
  classical
    have h := congr_arg (fun n => ↑n : ℕ → ZMod 2) G.sum_degrees_eq_twice_card_edges
    simp only [ZMod.nat_cast_self, MulZeroClass.zero_mul, Nat.cast_mul] at h
    rw [Nat.cast_sum, ← sum_filter_ne_zero] at h
    rw [@sum_congr _ _ _ _ (fun v => (G.degree v : ZMod 2)) (fun v => (1 : ZMod 2)) _ rfl] at h
    · simp only [filter_congr_decidable, mul_one, nsmul_eq_mul, sum_const, Ne.def] at h
      rw [← ZMod.eq_zero_iff_even]
      convert h
      ext v
      rw [← ZMod.ne_zero_iff_odd]
    · intro v
      simp only [true_and_iff, mem_filter, mem_univ, Ne.def]
      rw [ZMod.eq_zero_iff_even, ZMod.eq_one_iff_odd, Nat.odd_iff_not_even, imp_self]
      trivial
#align simple_graph.even_card_odd_degree_vertices SimpleGraph.even_card_odd_degree_vertices

/- warning: simple_graph.odd_card_odd_degree_vertices_ne -> SimpleGraph.odd_card_odd_degree_vertices_ne is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableEq.{succ u1} V] [_inst_3 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] (v : V), (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) v))) -> (Odd.{0} Nat Nat.semiring (Finset.card.{u1} V (Finset.filter.{u1} V (fun (w : V) => And (Ne.{succ u1} V w v) (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G w (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) w)))) (fun (a : V) => And.decidable (Ne.{succ u1} V a v) (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) a))) (Ne.decidable.{succ u1} V (fun (a : V) (b : V) => _inst_2 a b) a v) (Nat.Odd.decidablePred (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) a)))) (Finset.univ.{u1} V _inst_1))))
but is expected to have type
  forall {V : Type.{u1}} (G : SimpleGraph.{u1} V) [_inst_1 : Fintype.{u1} V] [_inst_2 : DecidableEq.{succ u1} V] [_inst_3 : DecidableRel.{succ u1} V (SimpleGraph.Adj.{u1} V G)] (v : V), (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G v (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) v))) -> (Odd.{0} Nat Nat.semiring (Finset.card.{u1} V (Finset.filter.{u1} V (fun (w : V) => And (Ne.{succ u1} V w v) (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G w (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) w)))) (fun (a : V) => instDecidableAnd (Ne.{succ u1} V a v) (Odd.{0} Nat Nat.semiring (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) a))) (instDecidableNot (Eq.{succ u1} V a v) (_inst_2 a v)) (Nat.instDecidablePredNatOddSemiring (SimpleGraph.degree.{u1} V G a (SimpleGraph.neighborSetFintype.{u1} V G _inst_1 (fun (a : V) (b : V) => _inst_3 a b) a)))) (Finset.univ.{u1} V _inst_1))))
Case conversion may be inaccurate. Consider using '#align simple_graph.odd_card_odd_degree_vertices_ne SimpleGraph.odd_card_odd_degree_vertices_neₓ'. -/
theorem odd_card_odd_degree_vertices_ne [Fintype V] [DecidableEq V] [DecidableRel G.Adj] (v : V)
    (h : Odd (G.degree v)) : Odd (univ.filterₓ fun w => w ≠ v ∧ Odd (G.degree w)).card :=
  by
  rcases G.even_card_odd_degree_vertices with ⟨k, hg⟩
  have hk : 0 < k :=
    by
    have hh : (Filter (fun v : V => Odd (G.degree v)) univ).Nonempty :=
      by
      use v
      simp only [true_and_iff, mem_filter, mem_univ]
      use h
    rwa [← card_pos, hg, ← two_mul, zero_lt_mul_left] at hh
    exact zero_lt_two
  have hc : (fun w : V => w ≠ v ∧ Odd (G.degree w)) = fun w : V => Odd (G.degree w) ∧ w ≠ v :=
    by
    ext w
    rw [and_comm']
  simp only [hc, filter_congr_decidable]
  rw [← filter_filter, filter_ne', card_erase_of_mem]
  · refine' ⟨k - 1, tsub_eq_of_eq_add <| hg.trans _⟩
    rw [add_assoc, one_add_one_eq_two, ← Nat.mul_succ, ← two_mul]
    congr
    exact (tsub_add_cancel_of_le <| Nat.succ_le_iff.2 hk).symm
  · simpa only [true_and_iff, mem_filter, mem_univ]
#align simple_graph.odd_card_odd_degree_vertices_ne SimpleGraph.odd_card_odd_degree_vertices_ne

#print SimpleGraph.exists_ne_odd_degree_of_exists_odd_degree /-
theorem exists_ne_odd_degree_of_exists_odd_degree [Fintype V] [DecidableRel G.Adj] (v : V)
    (h : Odd (G.degree v)) : ∃ w : V, w ≠ v ∧ Odd (G.degree w) :=
  by
  haveI := Classical.decEq V
  rcases G.odd_card_odd_degree_vertices_ne v h with ⟨k, hg⟩
  have hg' : (Filter (fun w : V => w ≠ v ∧ Odd (G.degree w)) univ).card > 0 :=
    by
    rw [hg]
    apply Nat.succ_pos
  rcases card_pos.mp hg' with ⟨w, hw⟩
  simp only [true_and_iff, mem_filter, mem_univ, Ne.def] at hw
  exact ⟨w, hw⟩
#align simple_graph.exists_ne_odd_degree_of_exists_odd_degree SimpleGraph.exists_ne_odd_degree_of_exists_odd_degree
-/

end SimpleGraph


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Devon Tuma
-/
import ring_theory.ideal.quotient
import ring_theory.polynomial.basic

/-!
# Jacobson radical

The Jacobson radical of a ring `R` is defined to be the intersection of all maximal ideals of `R`.
This is similar to how the nilradical is equal to the intersection of all prime ideals of `R`.

We can extend the idea of the nilradical to ideals of `R`,
by letting the radical of an ideal `I` be the intersection of prime ideals containing `I`.
Under this extension, the original nilradical is the radical of the zero ideal `⊥`.
Here we define the Jacobson radical of an ideal `I` in a similar way,
as the intersection of maximal ideals containing `I`.

## Main definitions

Let `R` be a commutative ring, and `I` be an ideal of `R`

* `jacobson I` is the jacobson radical, i.e. the infimum of all maximal ideals containing I.

* `is_local I` is the proposition that the jacobson radical of `I` is itself a maximal ideal

## Main statements

* `mem_jacobson_iff` gives a characterization of members of the jacobson of I

* `is_local_of_is_maximal_radical`: if the radical of I is maximal then so is the jacobson radical

## Tags

Jacobson, Jacobson radical, Local Ideal

-/

universes u v

namespace ideal
variables {R : Type u} [comm_ring R] {I : ideal R}
variables {S : Type v} [comm_ring S]
open_locale polynomial

section jacobson

/-- The Jacobson radical of `I` is the infimum of all maximal ideals containing `I`. -/
def jacobson (I : ideal R) : ideal R :=
Inf {J : ideal R | I ≤ J ∧ is_maximal J}

lemma le_jacobson : I ≤ jacobson I :=
λ x hx, mem_Inf.mpr (λ J hJ, hJ.left hx)

@[simp] lemma jacobson_idem : jacobson (jacobson I) = jacobson I :=
le_antisymm (Inf_le_Inf (λ J hJ, ⟨Inf_le hJ, hJ.2⟩)) le_jacobson

lemma radical_le_jacobson : radical I ≤ jacobson I :=
le_Inf (λ J hJ, (radical_eq_Inf I).symm ▸ Inf_le ⟨hJ.left, is_maximal.is_prime hJ.right⟩)

lemma eq_radical_of_eq_jacobson : jacobson I = I → radical I = I :=
λ h, le_antisymm (le_trans radical_le_jacobson (le_of_eq h)) le_radical

@[simp] lemma jacobson_top : jacobson (⊤ : ideal R) = ⊤ :=
eq_top_iff.2 le_jacobson

@[simp] theorem jacobson_eq_top_iff : jacobson I = ⊤ ↔ I = ⊤ :=
⟨λ H, classical.by_contradiction $ λ hi, let ⟨M, hm, him⟩ := exists_le_maximal I hi in
  lt_top_iff_ne_top.1
    (lt_of_le_of_lt (show jacobson I ≤ M, from Inf_le ⟨him, hm⟩) $
      lt_top_iff_ne_top.2 hm.ne_top) H,
λ H, eq_top_iff.2 $ le_Inf $ λ J ⟨hij, hj⟩, H ▸ hij⟩

lemma jacobson_eq_bot : jacobson I = ⊥ → I = ⊥ :=
λ h, eq_bot_iff.mpr (h ▸ le_jacobson)

lemma jacobson_eq_self_of_is_maximal [H : is_maximal I] : I.jacobson = I :=
le_antisymm (Inf_le ⟨le_of_eq rfl, H⟩) le_jacobson

@[priority 100]
instance jacobson.is_maximal [H : is_maximal I] : is_maximal (jacobson I) :=
⟨⟨λ htop, H.1.1 (jacobson_eq_top_iff.1 htop),
  λ J hJ, H.1.2 _ (lt_of_le_of_lt le_jacobson hJ)⟩⟩

theorem mem_jacobson_iff {x : R} : x ∈ jacobson I ↔ ∀ y, ∃ z, x * y * z + z - 1 ∈ I :=
⟨λ hx y, classical.by_cases
  (assume hxy : I ⊔ span {x * y + 1} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 hxy) in
    let ⟨r, hr⟩ := mem_span_singleton.1 hq in
    ⟨r, by rw [← one_mul r, ← mul_assoc, ← add_mul, mul_one, ← hr, ← hpq, ← neg_sub,
               add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume hxy : I ⊔ span {x * y + 1} ≠ ⊤,
    let ⟨M, hm1, hm2⟩ := exists_le_maximal _ hxy in
    suffices x ∉ M, from (this $ mem_Inf.1 hx ⟨le_trans le_sup_left hm2, hm1⟩).elim,
    λ hxm, hm1.1.1 $ (eq_top_iff_one _).2 $ add_sub_cancel' (x * y) 1 ▸ M.sub_mem
      (le_sup_right.trans hm2 $ mem_span_singleton.2 dvd_rfl)
      (M.mul_mem_right _ hxm)),
λ hx, mem_Inf.2 $ λ M ⟨him, hm⟩, classical.by_contradiction $ λ hxm,
  let ⟨y, hy⟩ := hm.exists_inv hxm, ⟨z, hz⟩ := hx (-y) in
  hm.1.1 $ (eq_top_iff_one _).2 $ sub_sub_cancel (x * -y * z + z) 1 ▸ M.sub_mem
    (by { rw [← one_mul z, ← mul_assoc, ← add_mul, mul_one, mul_neg, neg_add_eq_sub,
        ← neg_sub, neg_mul, neg_mul_eq_mul_neg, mul_comm x y, mul_comm _ (- z)],
      rcases hy with ⟨i, hi, df⟩,
      rw [← (sub_eq_iff_eq_add.mpr df.symm), sub_sub, add_comm, ← sub_sub, sub_self, zero_sub],
      refine M.mul_mem_left (-z) ((neg_mem_iff _).mpr hi) }) (him hz)⟩

lemma exists_mul_sub_mem_of_sub_one_mem_jacobson {I : ideal R} (r : R)
  (h : r - 1 ∈ jacobson I) : ∃ s, r * s - 1 ∈ I :=
begin
  cases mem_jacobson_iff.1 h 1 with s hs,
  use s,
  simpa [sub_mul] using hs
end

lemma is_unit_of_sub_one_mem_jacobson_bot (r : R)
  (h : r - 1 ∈ jacobson (⊥ : ideal R)) : is_unit r :=
begin
  cases exists_mul_sub_mem_of_sub_one_mem_jacobson r h with s hs,
  rw [mem_bot, sub_eq_zero] at hs,
  exact is_unit_of_mul_eq_one _ _ hs
end

/-- An ideal equals its Jacobson radical iff it is the intersection of a set of maximal ideals.
Allowing the set to include ⊤ is equivalent, and is included only to simplify some proofs. -/
theorem eq_jacobson_iff_Inf_maximal :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
begin
  use λ hI, ⟨{J : ideal R | I ≤ J ∧ J.is_maximal}, ⟨λ _ hJ, or.inl hJ.right, hI.symm⟩⟩,
  rintros ⟨M, hM, hInf⟩,
  refine le_antisymm (λ x hx, _) le_jacobson,
  rw [hInf, mem_Inf],
  intros I hI,
  cases hM I hI with is_max is_top,
  { exact (mem_Inf.1 hx) ⟨le_Inf_iff.1 (le_of_eq hInf) I hI, is_max⟩ },
  { exact is_top.symm ▸ submodule.mem_top }
end

theorem eq_jacobson_iff_Inf_maximal' :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
eq_jacobson_iff_Inf_maximal.trans
  ⟨λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ K hK, or.rec_on (hM.1 J hJ) (λ h, h.1.2 K hK)
    (λ h, eq_top_iff.2 (le_of_lt (h ▸ hK))), hM.2⟩⟩,
  λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ, or.rec_on (classical.em (J = ⊤)) (λ h, or.inr h)
    (λ h, or.inl ⟨⟨h, hM.1 J hJ⟩⟩), hM.2⟩⟩⟩

/-- An ideal `I` equals its Jacobson radical if and only if every element outside `I`
also lies outside of a maximal ideal containing `I`. -/
lemma eq_jacobson_iff_not_mem :
  I.jacobson = I ↔ ∀ x ∉ I, ∃ M : ideal R, (I ≤ M ∧ M.is_maximal) ∧ x ∉ M :=
begin
  split,
  { intros h x hx,
    erw [← h, mem_Inf] at hx,
    push_neg at hx,
    exact hx },
  { refine λ h, le_antisymm (λ x hx, _) le_jacobson,
    contrapose hx,
    erw mem_Inf,
    push_neg,
    exact h x hx }
end

theorem map_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) :
  ring_hom.ker f ≤ I → map f (I.jacobson) = (map f I).jacobson :=
begin
  intro h,
  unfold ideal.jacobson,
  have : ∀ J ∈ {J : ideal R | I ≤ J ∧ J.is_maximal}, f.ker ≤ J := λ J hJ, le_trans h hJ.left,
  refine trans (map_Inf hf this) (le_antisymm _ _),
  { refine Inf_le_Inf (λ J hJ, ⟨comap f J, ⟨⟨le_comap_of_map_le hJ.1, _⟩,
    map_comap_of_surjective f hf J⟩⟩),
    haveI : J.is_maximal := hJ.right,
    exact comap_is_maximal_of_surjective f hf },
  { refine Inf_le_Inf_of_subset_insert_top (λ j hj, hj.rec_on (λ J hJ, _)),
    rw ← hJ.2,
    cases map_eq_top_or_is_maximal_of_surjective f hf hJ.left.right with htop hmax,
    { exact htop.symm ▸ set.mem_insert ⊤ _ },
    { exact set.mem_insert_of_mem ⊤ ⟨map_mono hJ.1.1, hmax⟩ } },
end

lemma map_jacobson_of_bijective {f : R →+* S} (hf : function.bijective f) :
  map f (I.jacobson) = (map f I).jacobson :=
map_jacobson_of_surjective hf.right
  (le_trans (le_of_eq (f.injective_iff_ker_eq_bot.1 hf.left)) bot_le)

lemma comap_jacobson {f : R →+* S} {K : ideal S} :
  comap f (K.jacobson) = Inf (comap f '' {J : ideal S | K ≤ J ∧ J.is_maximal}) :=
trans (comap_Inf' f _) (Inf_eq_infi).symm

theorem comap_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) {K : ideal S} :
  comap f (K.jacobson) = (comap f K).jacobson :=
begin
  unfold ideal.jacobson,
  refine le_antisymm _ _,
  { refine le_trans (comap_mono (le_of_eq (trans top_inf_eq.symm Inf_insert.symm))) _,
    rw [comap_Inf', Inf_eq_infi],
    refine infi_le_infi_of_subset (λ J hJ, _),
    have : comap f (map f J) = J := trans (comap_map_of_surjective f hf J)
      (le_antisymm (sup_le_iff.2 ⟨le_of_eq rfl, le_trans (comap_mono bot_le) hJ.left⟩) le_sup_left),
    cases map_eq_top_or_is_maximal_of_surjective _ hf hJ.right with htop hmax,
    { refine ⟨⊤, ⟨set.mem_insert ⊤ _, htop ▸ this⟩⟩ },
    { refine ⟨map f J, ⟨set.mem_insert_of_mem _
        ⟨le_map_of_comap_le_of_surjective f hf hJ.1, hmax⟩, this⟩⟩ } },
  { rw comap_Inf,
    refine le_infi_iff.2 (λ J, (le_infi_iff.2 (λ hJ, _))),
    haveI : J.is_maximal := hJ.right,
    refine Inf_le ⟨comap_mono hJ.left, comap_is_maximal_of_surjective _ hf⟩ }
end

lemma mem_jacobson_bot {x : R} : x ∈ jacobson (⊥ : ideal R) ↔ ∀ y, is_unit (x * y + 1) :=
⟨λ hx y, let ⟨z, hz⟩ := (mem_jacobson_iff.1 hx) y in
  is_unit_iff_exists_inv.2 ⟨z, by rwa [add_mul, one_mul, ← sub_eq_zero]⟩,
λ h, mem_jacobson_iff.mpr (λ y, (let ⟨b, hb⟩ := is_unit_iff_exists_inv.1 (h y) in
  ⟨b, (submodule.mem_bot R).2 (hb ▸ (by ring))⟩))⟩

/-- An ideal `I` of `R` is equal to its Jacobson radical if and only if
the Jacobson radical of the quotient ring `R/I` is the zero ideal -/
theorem jacobson_eq_iff_jacobson_quotient_eq_bot :
  I.jacobson = I ↔ jacobson (⊥ : ideal (R ⧸ I)) = ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    replace h := congr_arg (map (quotient.mk I)) h,
    rw map_jacobson_of_surjective hf (le_of_eq mk_ker) at h,
    simpa using h },
  { intro h,
    replace h := congr_arg (comap (quotient.mk I)) h,
    rw [comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at h,
    simpa using h }
end

/-- The standard radical and Jacobson radical of an ideal `I` of `R` are equal if and only if
the nilradical and Jacobson radical of the quotient ring `R/I` coincide -/
theorem radical_eq_jacobson_iff_radical_quotient_eq_jacobson_bot :
  I.radical = I.jacobson ↔ radical (⊥ : ideal (R ⧸ I)) = jacobson ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    have := congr_arg (map (quotient.mk I)) h,
    rw [map_radical_of_surjective hf (le_of_eq mk_ker),
      map_jacobson_of_surjective hf (le_of_eq mk_ker)] at this,
    simpa using this },
  { intro h,
    have := congr_arg (comap (quotient.mk I)) h,
    rw [comap_radical, comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at this,
    simpa using this }
end

@[mono] lemma jacobson_mono {I J : ideal R} : I ≤ J → I.jacobson ≤ J.jacobson :=
begin
  intros h x hx,
  erw mem_Inf at ⊢ hx,
  exact λ K ⟨hK, hK_max⟩, hx ⟨trans h hK, hK_max⟩
end

lemma jacobson_radical_eq_jacobson :
  I.radical.jacobson = I.jacobson :=
le_antisymm (le_trans (le_of_eq (congr_arg jacobson (radical_eq_Inf I)))
  (Inf_le_Inf (λ J hJ, ⟨Inf_le ⟨hJ.1, hJ.2.is_prime⟩, hJ.2⟩))) (jacobson_mono le_radical)

end jacobson

section polynomial
open polynomial

lemma jacobson_bot_polynomial_le_Inf_map_maximal :
  jacobson (⊥ : ideal R[X]) ≤ Inf (map C '' {J : ideal R | J.is_maximal}) :=
begin
  refine le_Inf (λ J, exists_imp_distrib.2 (λ j hj, _)),
  haveI : j.is_maximal := hj.1,
  refine trans (jacobson_mono bot_le) (le_of_eq _ : J.jacobson ≤ J),
  suffices : (⊥ : ideal (polynomial (R ⧸ j))).jacobson = ⊥,
  { rw [← hj.2, jacobson_eq_iff_jacobson_quotient_eq_bot],
    replace this :=
    congr_arg (map (polynomial_quotient_equiv_quotient_polynomial j).to_ring_hom) this,
    rwa [map_jacobson_of_bijective _, map_bot] at this,
    exact (ring_equiv.bijective (polynomial_quotient_equiv_quotient_polynomial j)) },
  refine eq_bot_iff.2 (λ f hf, _),
  simpa [(λ hX, by simpa using congr_arg (λ f, coeff f 1) hX : (X : (R ⧸ j)[X]) ≠ 0)]
    using eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit ((mem_jacobson_bot.1 hf) X)),
end

lemma jacobson_bot_polynomial_of_jacobson_bot (h : jacobson (⊥ : ideal R) = ⊥) :
  jacobson (⊥ : ideal R[X]) = ⊥ :=
begin
  refine eq_bot_iff.2 (le_trans jacobson_bot_polynomial_le_Inf_map_maximal _),
  refine (λ f hf, ((submodule.mem_bot _).2 (polynomial.ext (λ n, trans _ (coeff_zero n).symm)))),
  suffices : f.coeff n ∈ ideal.jacobson ⊥, by rwa [h, submodule.mem_bot] at this,
  exact mem_Inf.2 (λ j hj, (mem_map_C_iff.1 ((mem_Inf.1 hf) ⟨j, ⟨hj.2, rfl⟩⟩)) n),
end

end polynomial

section is_local

/-- An ideal `I` is local iff its Jacobson radical is maximal. -/
class is_local (I : ideal R) : Prop := (out : is_maximal (jacobson I))

theorem is_local_iff {I : ideal R} : is_local I ↔ is_maximal (jacobson I) :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_local_of_is_maximal_radical {I : ideal R} (hi : is_maximal (radical I)) : is_local I :=
⟨have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
show is_maximal (jacobson I), from this ▸ hi⟩

theorem is_local.le_jacobson {I J : ideal R} (hi : is_local I) (hij : I ≤ J) (hj : J ≠ ⊤) :
  J ≤ jacobson I :=
let ⟨M, hm, hjm⟩ := exists_le_maximal J hj in
le_trans hjm $ le_of_eq $ eq.symm $ hi.1.eq_of_le hm.1.1 $ Inf_le ⟨le_trans hij hjm, hm⟩

theorem is_local.mem_jacobson_or_exists_inv {I : ideal R} (hi : is_local I) (x : R) :
  x ∈ jacobson I ∨ ∃ y, y * x - 1 ∈ I :=
classical.by_cases
  (assume h : I ⊔ span {x} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 h) in
    let ⟨r, hr⟩ := mem_span_singleton.1 hq in
    or.inr ⟨r, by rw [← hpq, mul_comm, ← hr, ← neg_sub, add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume h : I ⊔ span {x} ≠ ⊤,
    or.inl $ le_trans le_sup_right (hi.le_jacobson le_sup_left h) $ mem_span_singleton.2 $
      dvd_refl x)

end is_local

theorem is_primary_of_is_maximal_radical {I : ideal R} (hi : is_maximal (radical I)) :
  is_primary I :=
have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
⟨ne_top_of_lt $ lt_of_le_of_lt le_radical (lt_top_iff_ne_top.2 hi.1.1),
λ x y hxy, ((is_local_of_is_maximal_radical hi).mem_jacobson_or_exists_inv y).symm.imp
  (λ ⟨z, hz⟩, by rw [← mul_one x, ← sub_sub_cancel (z * y) 1, mul_sub, mul_left_comm]; exact
    I.sub_mem (I.mul_mem_left _ hxy) (I.mul_mem_left _ hz))
  (this ▸ id)⟩

end ideal


/-
Copyright (c) 2020 Johan Commelin, Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Damiano Testa
-/
import order.basic
import data.equiv.basic

/-!
# Initial lemmas to work with the `order_dual`

## Definitions
`to_dual` and `of_dual` the order reversing identity maps, bundled as equivalences.

## Basic Lemmas to convert between an order and its dual

This file is similar to algebra/group/type_tags.lean
-/

open function

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}

namespace order_dual

instance [nontrivial α] : nontrivial (order_dual α) := by delta order_dual; assumption

/-- `to_dual` is the identity function to the `order_dual` of a linear order.  -/
def to_dual : α ≃ order_dual α := ⟨id, id, λ h, rfl, λ h, rfl⟩

/-- `of_dual` is the identity function from the `order_dual` of a linear order.  -/
def of_dual : order_dual α ≃ α := to_dual.symm

@[simp] lemma to_dual_symm_eq : (@to_dual α).symm = of_dual := rfl

@[simp] lemma of_dual_symm_eq : (@of_dual α).symm = to_dual := rfl

@[simp] lemma to_dual_of_dual (a : order_dual α) : to_dual (of_dual a) = a := rfl
@[simp] lemma of_dual_to_dual (a : α) : of_dual (to_dual a) = a := rfl

@[simp] lemma to_dual_inj {a b : α} :
  to_dual a = to_dual b ↔ a = b := iff.rfl

@[simp] lemma to_dual_le_to_dual [has_le α] {a b : α} :
  to_dual a ≤ to_dual b ↔ b ≤ a := iff.rfl

@[simp] lemma to_dual_lt_to_dual [has_lt α] {a b : α} :
  to_dual a < to_dual b ↔ b < a := iff.rfl

@[simp] lemma of_dual_inj {a b : order_dual α} :
  of_dual a = of_dual b ↔ a = b := iff.rfl

@[simp] lemma of_dual_le_of_dual [has_le α] {a b : order_dual α} :
  of_dual a ≤ of_dual b ↔ b ≤ a := iff.rfl

@[simp] lemma of_dual_lt_of_dual [has_lt α] {a b : order_dual α} :
  of_dual a < of_dual b ↔ b < a := iff.rfl

lemma le_to_dual [has_le α] {a : order_dual α} {b : α} :
  a ≤ to_dual b ↔ b ≤ of_dual a := iff.rfl

lemma lt_to_dual [has_lt α] {a : order_dual α} {b : α} :
  a < to_dual b ↔ b < of_dual a := iff.rfl

lemma to_dual_le [has_le α] {a : α} {b : order_dual α} :
  to_dual a ≤ b ↔ of_dual b ≤ a := iff.rfl

lemma to_dual_lt [has_lt α] {a : α} {b : order_dual α} :
  to_dual a < b ↔ of_dual b < a := iff.rfl

end order_dual


/-
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
-/
import tactic.ring_exp
import topology.metric_space.hausdorff_distance

/-!
# 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 theory
open_locale classical topology filter
open topological_space set metric filter function

local attribute [simp] pow_le_pow_iff one_lt_two inv_le_inv

variable {E : ℕ → Type*}

namespace pi_nat

/-! ### 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`. -/
@[irreducible, pp_nodot] def first_diff (x y : Π n, E n) : ℕ :=
if h : x ≠ y then nat.find (ne_iff.1 h) else 0

lemma apply_first_diff_ne {x y : Π n, E n} (h : x ≠ y) :
  x (first_diff x y) ≠ y (first_diff x y) :=
begin
  rw [first_diff, dif_pos h],
  exact nat.find_spec (ne_iff.1 h),
end

lemma apply_eq_of_lt_first_diff {x y : Π n, E n} {n : ℕ} (hn : n < first_diff x y) :
  x n = y n :=
begin
  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 }
end

lemma first_diff_comm (x y : Π n, E n) :
  first_diff x y = first_diff y x :=
begin
  rcases eq_or_ne x y with rfl|hxy, { refl },
  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 }
end

lemma min_first_diff_le (x y z : Π n, E n) (h : x ≠ z) :
  min (first_diff x y) (first_diff y z) ≤ first_diff x z :=
begin
  by_contra' H,
  have : x (first_diff x z) = z (first_diff x z), from 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,
end

/-! ### 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}

lemma cylinder_eq_pi (x : Π n, E n) (n : ℕ) :
  cylinder x n = set.pi (finset.range n : set ℕ) (λ (i : ℕ), {x i}) :=
by { ext y, simp [cylinder] }

@[simp] lemma cylinder_zero (x : Π n, E n) : cylinder x 0 = univ :=
by simp [cylinder_eq_pi]

lemma cylinder_anti (x : Π n, E n) {m n : ℕ} (h : m ≤ n) : cylinder x n ⊆ cylinder x m :=
λ y hy i hi, hy i (hi.trans_le h)

@[simp] lemma mem_cylinder_iff {x y : Π n, E n} {n : ℕ} :
  y ∈ cylinder x n ↔ ∀ i, i < n → y i = x i :=
iff.rfl

lemma self_mem_cylinder (x : Π n, E n) (n : ℕ) :
  x ∈ cylinder x n :=
by simp

lemma mem_cylinder_iff_eq {x y : Π n, E n} {n : ℕ} :
  y ∈ cylinder x n ↔ cylinder y n = cylinder x n :=
begin
  split,
  { assume hy,
    apply subset.antisymm,
    { assume z hz i hi,
      rw ← hy i hi,
      exact hz i hi },
    { assume z hz i hi,
      rw hy i hi,
      exact hz i hi } },
  { assume h,
    rw ← h,
    exact self_mem_cylinder _ _ }
end

lemma 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]

lemma mem_cylinder_iff_le_first_diff {x y : Π n, E n} (hne : x ≠ y) (i : ℕ) :
  x ∈ cylinder y i ↔ i ≤ first_diff x y :=
begin
  split,
  { assume h,
    by_contra',
    exact apply_first_diff_ne hne (h _ this) },
  { assume hi j hj,
    exact apply_eq_of_lt_first_diff (hj.trans_le hi) }
end

lemma mem_cylinder_first_diff (x y : Π n, E n) :
  x ∈ cylinder y (first_diff x y) :=
λ i hi, apply_eq_of_lt_first_diff hi

lemma cylinder_eq_cylinder_of_le_first_diff (x y : Π n, E n) {n : ℕ} (hn : n ≤ first_diff x y) :
  cylinder x n = cylinder y n :=
begin
  rw ← mem_cylinder_iff_eq,
  assume i hi,
  exact apply_eq_of_lt_first_diff (hi.trans_le hn),
end

lemma Union_cylinder_update (x : Π n, E n) (n : ℕ) :
  (⋃ k, cylinder (update x n k) (n+1)) = cylinder x n :=
begin
  ext y,
  simp only [mem_cylinder_iff, mem_Union],
  split,
  { rintros ⟨k, hk⟩ i hi,
    simpa [hi.ne] using hk i (nat.lt_succ_of_lt hi) },
  { assume H,
    refine ⟨y n, λ 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 } },
end

/-!
### 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 has_dist : has_dist (Π n, E n) :=
⟨λ x y, if h : x ≠ y then (1/2 : ℝ) ^ (first_diff x y) else 0⟩

local attribute [instance] pi_nat.has_dist

lemma dist_eq_of_ne {x y : Π n, E n} (h : x ≠ y) :
  dist x y = (1/2 : ℝ) ^ (first_diff x y) :=
by simp [dist, h]

protected lemma dist_self (x : Π n, E n) : dist x x = 0 :=
by simp [dist]

protected lemma dist_comm (x y : Π n, E n) : dist x y = dist y x :=
by simp [dist, @eq_comm _ x y, first_diff_comm]

protected lemma dist_nonneg (x y : Π n, E n) : 0 ≤ dist x y :=
begin
  rcases eq_or_ne x y with rfl|h,
  { simp [dist] },
  { simp [dist, h] }
end

lemma dist_triangle_nonarch (x y z : Π n, E n) :
  dist x z ≤ max (dist x y) (dist y z) :=
begin
  rcases eq_or_ne x z with rfl|hxz,
  { simp [pi_nat.dist_self x, pi_nat.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)],
end

protected lemma 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 (pi_nat.dist_nonneg _ _) (pi_nat.dist_nonneg _ _)

protected lemma eq_of_dist_eq_zero (x y : Π n, E n) (hxy : dist x y = 0) : x = y :=
begin
  rcases eq_or_ne x y with rfl|h, { refl },
  simp [dist_eq_of_ne h] at hxy,
  exact (two_ne_zero (pow_eq_zero hxy)).elim
end

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

lemma 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 :=
begin
  rcases eq_or_ne x y with rfl|hne, { refl },
  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),
end

/-- 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 -/
lemma lipschitz_with_one_iff_forall_dist_image_le_of_mem_cylinder
  {α : Type*} [pseudo_metric_space α] {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) :=
begin
  split,
  { assume H x y n hxy,
    apply (H x y).trans,
    rw pi_nat.dist_comm,
    exact mem_cylinder_iff_dist_le.1 hxy },
  { assume H x y,
    rcases eq_or_ne x y with rfl|hne, { simp [pi_nat.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 _ _ }
end

variables (E) [∀ n, topological_space (E n)] [∀ n, discrete_topology (E n)]

lemma is_topological_basis_cylinders  :
  is_topological_basis {s : set (Π n, E n) | ∃ (x : Π n, E n) (n : ℕ), s = cylinder x n} :=
begin
  apply is_topological_basis_of_open_of_nhds,
  { rintros u ⟨x, n, rfl⟩,
    rw cylinder_eq_pi,
    exact is_open_set_pi (finset.range n).finite_to_set (λ a ha, is_open_discrete _) },
  { assume 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) | is_open s}) ∧ S = (F : set ℕ).pi U}),
          x ∈ v ∧ v ⊆ u :=
      (is_topological_basis_pi (λ (n : ℕ), is_topological_basis_opens)).exists_subset_of_mem_open
        hx u_open,
    rcases finset.bdd_above F with ⟨n, hn⟩,
    refine ⟨cylinder x (n+1), ⟨x, n+1, rfl⟩, self_mem_cylinder _ _, subset.trans _ Uu⟩,
    assume y hy,
    suffices : ∀ (i : ℕ), i ∈ F → y i ∈ U i, by simpa,
    assume 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 }
end

variable {E}

lemma is_open_iff_dist (s : set (Π n, E n)) :
  is_open s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s :=
begin
  split,
  { assume 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,
      λ y hy, h's (λ i hi, (apply_eq_of_dist_lt hy hi.le).symm)⟩ },
  { assume h,
    apply (is_topological_basis_cylinders E).is_open_iff.2 (λ 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, λ y hy, hε y _⟩,
    rw pi_nat.dist_comm,
    exact (mem_cylinder_iff_dist_le.1 hy).trans_lt hn }
end

/-- 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 metric_space : metric_space (Π n, E n) :=
metric_space.of_dist_topology dist pi_nat.dist_self pi_nat.dist_comm pi_nat.dist_triangle
  is_open_iff_dist pi_nat.eq_of_dist_eq_zero

/-- 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 metric_space_of_discrete_uniformity {E : ℕ → Type*} [∀ n, uniform_space (E n)]
  (h : ∀ n, uniformity (E n) = 𝓟 id_rel) : metric_space (Π n, E n) :=
begin
  haveI : ∀ n, discrete_topology (E n) := λ n, discrete_topology_of_discrete_uniformity (h n),
  exact
  { dist_triangle := pi_nat.dist_triangle,
    dist_comm := pi_nat.dist_comm,
    dist_self := pi_nat.dist_self,
    eq_of_dist_eq_zero := pi_nat.eq_of_dist_eq_zero,
    to_uniform_space := Pi.uniform_space _,
    uniformity_dist :=
    begin
      simp [Pi.uniformity, comap_infi, gt_iff_lt, preimage_set_of_eq, comap_principal,
        pseudo_metric_space.uniformity_dist, h, id_rel],
      apply le_antisymm,
      { simp only [le_infi_iff, le_principal_iff],
        assume ε ε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_to_set
          (λ 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, implies_true_iff] },
        { rintros ⟨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_infi_iff, le_principal_iff],
        assume 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],
        assume x y hxy,
        exact apply_eq_of_dist_lt hxy le_rfl }
    end }
end

/-- 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 metric_space_nat_nat : metric_space (ℕ → ℕ) :=
pi_nat.metric_space_of_discrete_uniformity (λ n, rfl)

local attribute [instance] pi_nat.metric_space

protected lemma complete_space : complete_space (Π n, E n) :=
begin
  refine metric.complete_of_convergent_controlled_sequences (λ n, (1/2)^n) (by simp) _,
  assume u hu,
  refine ⟨λ n, u n n, tendsto_pi_nhds.2 (λ i, _)⟩,
  refine tendsto_const_nhds.congr' _,
  filter_upwards [filter.Ici_mem_at_top i] with n hn,
  exact apply_eq_of_dist_lt (hu i i n le_rfl hn) le_rfl,
end

/-!
### 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`.
-/

lemma exists_disjoint_cylinder {s : set (Π n, E n)} (hs : is_closed s) {x : Π n, E n} (hx : x ∉ s) :
  ∃ n, disjoint s (cylinder x n) :=
begin
  unfreezingI { 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 (λ 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
end

/-- 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 shortest_prefix_diff {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

lemma first_diff_lt_shortest_prefix_diff {s : set (Π n, E n)} (hs : is_closed s)
  {x y : (Π n, E n)} (hx : x ∉ s) (hy : y ∈ s) :
  first_diff x y < shortest_prefix_diff x s :=
begin
  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)
end

lemma shortest_prefix_diff_pos {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty)
  {x : (Π n, E n)} (hx : x ∉ s) :
  0 < shortest_prefix_diff x s :=
begin
  rcases hne with ⟨y, hy⟩,
  exact (zero_le _).trans_lt (first_diff_lt_shortest_prefix_diff hs hx hy)
end

/-- 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 longest_prefix {E : ℕ → Type*} (x : (Π n, E n)) (s : set (Π n, E n)) : ℕ :=
shortest_prefix_diff x s - 1

lemma first_diff_le_longest_prefix {s : set (Π n, E n)} (hs : is_closed s)
  {x y : (Π n, E n)} (hx : x ∉ s) (hy : y ∈ s) :
  first_diff x y ≤ longest_prefix x s :=
begin
  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 }
end

lemma inter_cylinder_longest_prefix_nonempty
  {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty) (x : (Π n, E n)) :
  (s ∩ cylinder x (longest_prefix x s)).nonempty :=
begin
  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),
  { 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
end

lemma disjoint_cylinder_of_longest_prefix_lt
  {s : set (Π n, E n)} (hs : is_closed s)
  {x : (Π n, E n)} (hx : x ∉ s) {n : ℕ} (hn : longest_prefix x s < n) :
  disjoint s (cylinder x n) :=
begin
  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,
end

/-- 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. -/
lemma cylinder_longest_prefix_eq_of_longest_prefix_lt_first_diff
  {x y : Π n, E n} {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty)
  (H : longest_prefix x s < first_diff x y) (xs : x ∉ s) (ys : y ∉ s) :
  cylinder x (longest_prefix x s) = cylinder y (longest_prefix y s) :=
begin
  have l_eq : longest_prefix y s = longest_prefix x s,
  { 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)
end

/-- 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_is_closed
  {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty) :
  ∃ f : (Π n, E n) → (Π n, E n), (∀ x ∈ s, f x = x) ∧ (range f = s) ∧ lipschitz_with 1 f :=
begin
  /- 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 := λ 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 := λ x xs, by simp [xs],
  refine ⟨f, fs, _, _⟩,
  -- check that the range of `f` is `s`.
  { apply subset.antisymm,
    { rintros 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).some_spec.1 },
    { assume x hx,
      rw ← fs x hx,
      exact mem_range_self _ } },
  -- check that `f` is `1`-Lipschitz, by a case analysis.
  { apply lipschitz_with.mk_one (λ 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),
    { 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),
        { 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),
        { 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),
          { cases H,
            { exact cylinder_longest_prefix_eq_of_longest_prefix_lt_first_diff hs hne H xs ys },
            { symmetry,
              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),
          { 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),
          { 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 } } } }
end

/-- 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_is_closed
  {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty) :
  ∃ f : (Π n, E n) → (Π n, E n), (∀ x ∈ s, f x = x) ∧ (range f = s) ∧ continuous f :=
begin
  rcases exists_lipschitz_retraction_of_is_closed hs hne with ⟨f, fs, frange, hf⟩,
  exact ⟨f, fs, frange, hf.continuous⟩
end

theorem exists_retraction_subtype_of_is_closed
  {s : set (Π n, E n)} (hs : is_closed s) (hne : s.nonempty) :
  ∃ f : (Π n, E n) → s, (∀ x : s, f x = x) ∧ surjective f ∧ continuous f :=
begin
  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,
  { assume x,
    apply subtype.coe_injective.eq_iff.1,
    simpa only using fs x.val x.property },
  exact ⟨cod_restrict f s A, B, λ x, ⟨x, B x⟩, f_cont.subtype_mk _⟩,
end

end pi_nat

open pi_nat

/-- 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`. -/
lemma exists_nat_nat_continuous_surjective_of_complete_space
  (α : Type*) [metric_space α] [complete_space α] [second_countable_topology α] [nonempty α] :
  ∃ (f : (ℕ → ℕ) → α), continuous f ∧ surjective f :=
begin
  /- 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 : metric_space (ℕ → ℕ) := pi_nat.metric_space_nat_nat,
  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 → α := λ x, x.2.some,
  have A : ∀ (x : s) (n : ℕ), dist (g x) (u ((x : ℕ → ℕ) n)) ≤ (1/2)^n :=
    λ x n, (mem_Inter.1 x.2.some_mem n : _),
  have g_cont : continuous g,
  { apply continuous_iff_continuous_at.2 (λ y, _),
    apply continuous_at_of_locally_lipschitz zero_lt_one 4 (λ 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_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_exp },
  have g_surj : surjective g,
  { assume y,
    have : ∀ (n : ℕ), ∃ j, y ∈ closed_ball (u j) ((1/2)^n),
    { assume 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 := λ 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 (λ (n : ℕ), (1/2 : ℝ)^n + (1/2)^n) at_top (𝓝 (0 + 0)) :=
      (tendsto_pow_at_top_nhds_0_of_lt_1 I0.le I1).add (tendsto_pow_at_top_nhds_0_of_lt_1 I0.le I1),
    rw add_zero at L,
    exact ge_of_tendsto' L J },
  have s_closed : is_closed s,
  { refine is_closed_iff_cluster_pt.mpr _,
    assume x hx,
    have L : tendsto (λ (n : ℕ), diam (closed_ball (u (x n)) ((1 / 2) ^ n))) at_top (𝓝 0),
    { have : tendsto (λ (n : ℕ), (2 : ℝ) * (1/2)^n) at_top (𝓝 (2 * 0)) :=
        (tendsto_pow_at_top_nhds_0_of_lt_1 I0.le I1).const_mul _,
      rw mul_zero at this,
      exact squeeze_zero (λ n, diam_nonneg) (λ n, diam_closed_ball (pow_nonneg I0.le _)) this },
    refine nonempty_Inter_of_nonempty_bInter (λ n, is_closed_ball) (λ n, bounded_closed_ball) _ L,
    assume N,
    obtain ⟨y, hxy, ys⟩ : ∃ y, y ∈ ball x ((1 / 2) ^ N) ∩ s :=
      cluster_pt_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),
    { 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,
  { 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⟩,
end

namespace pi_countable

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

variables {ι : Type*} [encodable ι] {F : ι → Type*} [∀ i, metric_space (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 has_dist : has_dist (Π i, F i) :=
⟨λ x y, ∑' (i : ι), min ((1/2)^(encode i)) (dist (x i) (y i))⟩

local attribute [instance] pi_countable.has_dist

lemma dist_eq_tsum (x y : Π i, F i) :
  dist x y = ∑' (i : ι), min ((1/2)^(encode i)) (dist (x i) (y i)) := rfl

lemma dist_summable (x y : Π i, F i) :
  summable (λ (i : ι), min ((1/2)^(encode i)) (dist (x i) (y i))) :=
begin
  refine summable_of_nonneg_of_le (λ i, _) (λ i, min_le_left _ _) summable_geometric_two_encode,
  exact le_min (pow_nonneg (by norm_num) _) (dist_nonneg)
end

lemma 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 (λ j hj, le_min (by simp) (dist_nonneg))

lemma 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] using min_le_iff.1 (min_dist_le_dist_pi x y i)

open_locale big_operators topology
open filter

open_locale 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 metric_space : metric_space (Π i, F i) :=
{ dist_self := λ x, by simp [dist_eq_tsum],
  dist_comm := λ x y, by simp [dist_eq_tsum, dist_comm],
  dist_triangle := λ x y z,
  begin
    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)) :=
    λ 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))) :
        begin
          convert congr_arg (coe : ℝ≥0 → ℝ)
            (min_add_distrib ((1/2 : ℝ≥0)^(encode i)) (nndist (x i) (y i)) (nndist (y i) (z i)));
          simp
        end
      ... ≤ 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)
  end,
  eq_of_dist_eq_zero :=
  begin
    assume x y hxy,
    ext1 n,
    rw [← dist_le_zero, ← hxy],
    apply dist_le_dist_pi_of_dist_lt,
    rw hxy,
    simp
  end,
  to_uniform_space := Pi.uniform_space _,
  uniformity_dist :=
  begin
    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,
      pseudo_metric_space.uniformity_dist],
    apply le_antisymm,
    { simp only [le_infi_iff, le_principal_iff],
      assume ε εpos,
      obtain ⟨K, hK⟩ : ∃ (K : finset ι), ∑' (i : {j // j ∉ K}), (1/2 : ℝ)^(encode (i : ι)) < ε/2 :=
        ((tendsto_order.1 (tendsto_tsum_compl_at_top_zero (λ (i : ι), (1/2 : ℝ)^(encode i)))).2
           _ (half_pos εpos)).exists,
      obtain ⟨δ, δpos, hδ⟩ : ∃ (δ : ℝ) (δpos : 0 < δ), (K.card : ℝ) * δ ≤ ε/2,
      { rcases nat.eq_zero_or_pos K.card with hK|hK,
        { exact ⟨1, zero_lt_one,
                  by simpa only [hK, nat.cast_zero, 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
        (λ i, {p : (Π (i : ι), F i) × Π (i : ι), F i | dist (p.fst i) (p.snd i) < δ}),
      { rintros ⟨i, hi⟩,
        refine mem_infi_of_mem δ (mem_infi_of_mem δpos _),
        simp only [prod.forall, imp_self, mem_principal] },
      { rintros ⟨x, y⟩ hxy,
        simp only [mem_Inter, mem_set_of_eq, set_coe.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 : ι)) :
          begin
            refine add_le_add (finset.sum_le_sum (λ i hi, min_le_right _ _)) _,
            refine tsum_le_tsum (λ i, min_le_left _ _) _ _,
            { apply summable.subtype (dist_summable x y) (↑K : set ι)ᶜ },
            { apply summable.subtype summable_geometric_two_encode (↑K : set ι)ᶜ }
          end
        ... < (∑ i in K, δ) + ε / 2 :
          begin
            apply add_lt_add_of_le_of_lt _ hK,
            apply finset.sum_le_sum (λ i hi, _),
            apply (hxy i _).le,
            simpa using hi
          end
        ... ≤ ε / 2 + ε / 2 :
          add_le_add_right (by simpa only [finset.sum_const, nsmul_eq_mul] using hδ) _
        ... = ε : add_halves _ } },
    { simp only [le_infi_iff, le_principal_iff],
      assume 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],
      assume x y hn hε,
      calc dist (x i) (y i) ≤ dist x y : dist_le_dist_pi_of_dist_lt hn
      ... < ε : hε }
  end }

end pi_countable


namespace forall_conjunct_left
  variables (α : Type) (p q : α → Prop)
  example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y :=
    assume h : ∀ x : α , p x ∧ q x,
    take k : α,
    show p k, from (h k).left
end forall_conjunct_left

namespace forall_rel_trans
  variables (α : Type) (r : α → α → Prop)
  variable trans_r : ∀ x y z, r x y → r y z → r x z

  variables a b c : α
  variables (hab : r a b) (hbc : r b c)

  #check trans_r
  #check trans_r a b c
  #check trans_r a b c hab
  #check trans_r a b c hab hbc
end forall_rel_trans

namespace forall_rel_trans_impl
  variables (α : Type) (r : α → α → Prop)
  variable trans_r : ∀ {x y z}, r x y → r y z → r x z

  variables a b c : α
  variables (hab : r a b) (hbc : r b c)

  #check trans_r
  #check trans_r hab
  #check trans_r hab hbc
end forall_rel_trans_impl

namespace forall_equiv
  variables (α : Type) (r : α → α → Prop)

  variable reflex_r : ∀ x, r x x
  variable symm_r : ∀ {x y}, r x y → r y x
  variable trans_r : ∀ {x y z}, r x y → r y z → r x z

  example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
  trans_r (trans_r hab (symm_r hcb)) hcd
end forall_equiv


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.combinatorics.composition
import Mathlib.data.nat.parity
import Mathlib.tactic.apply_fun
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Partitions

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
structure partition (n : ℕ) where
  parts : multiset ℕ
  parts_pos : ∀ {i : ℕ}, i ∈ parts → 0 < i
  parts_sum : multiset.sum parts = n

namespace partition

/-- A composition induces a partition (just convert the list to a multiset). -/
def of_composition (n : ℕ) (c : composition n) : partition n :=
  mk ↑(composition.blocks c) sorry sorry

theorem of_composition_surj {n : ℕ} : function.surjective (of_composition n) := sorry

/--
Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the

-- proof obligation `l.sum = n`.

def of_sums (n : ℕ) (l : multiset ℕ) (hl : multiset.sum l = n) : partition n :=
  mk (multiset.filter (fun (_x : ℕ) => _x ≠ 0) l) sorry sorry

/-- A `multiset ℕ` induces a partition on its sum. -/
def of_multiset (l : multiset ℕ) : partition (multiset.sum l) := of_sums (multiset.sum l) l sorry

/-- The partition of exactly one part. -/
def indiscrete_partition (n : ℕ) : partition n := of_sums n (singleton n) sorry

protected instance inhabited {n : ℕ} : Inhabited (partition n) :=
  { default := indiscrete_partition n }

/--
The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
theorem count_of_sums_of_ne_zero {n : ℕ} {l : multiset ℕ} (hl : multiset.sum l = n) {i : ℕ}
    (hi : i ≠ 0) : multiset.count i (parts (of_sums n l hl)) = multiset.count i l :=
  multiset.count_filter_of_pos hi

theorem count_of_sums_zero {n : ℕ} {l : multiset ℕ} (hl : multiset.sum l = n) :
    multiset.count 0 (parts (of_sums n l hl)) = 0 :=
  multiset.count_filter_of_neg fun (h : 0 ≠ 0) => h rfl

/--
Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
protected instance fintype (n : ℕ) : fintype (partition n) :=
  fintype.of_surjective (of_composition n) of_composition_surj

/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : finset (partition n) :=
  finset.filter (fun (c : partition n) => ∀ (i : ℕ), i ∈ parts c → ¬even i) finset.univ

/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : finset (partition n) :=
  finset.filter (fun (c : partition n) => multiset.nodup (parts c)) finset.univ

/-- The finset of those partitions in which every part is odd and used at most once. -/
def odd_distincts (n : ℕ) : finset (partition n) := odds n ∩ distincts n

end Mathlib


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

/-!
# Theory of degrees of polynomials

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

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

-/

noncomputable theory
open_locale classical polynomial

open finsupp finset

namespace polynomial
universes u v w
variables {R : Type u} {S : Type v} { ι : Type w} {a b : R} {m n : ℕ}

section semiring
variables [semiring R] {p q r : R[X]}

section degree

lemma nat_degree_comp_le : nat_degree (p.comp q) ≤ nat_degree p * nat_degree q :=
if h0 : p.comp q = 0 then by rw [h0, nat_degree_zero]; exact nat.zero_le _
else with_bot.coe_le_coe.1 $
  calc ↑(nat_degree (p.comp q)) = degree (p.comp q) : (degree_eq_nat_degree h0).symm
  ... = _ : congr_arg degree comp_eq_sum_left
  ... ≤ _ : degree_sum_le _ _
  ... ≤ _ : finset.sup_le (λ n hn,
    calc degree (C (coeff p n) * q ^ n)
        ≤ degree (C (coeff p n)) + degree (q ^ n) : degree_mul_le _ _
    ... ≤ nat_degree (C (coeff p n)) + n • (degree q) :
      add_le_add degree_le_nat_degree (degree_pow_le _ _)
    ... ≤ nat_degree (C (coeff p n)) + n • (nat_degree q) :
      add_le_add_left (nsmul_le_nsmul_of_le_right (@degree_le_nat_degree _ _ q) n) _
    ... = (n * nat_degree q : ℕ) :
     by rw [nat_degree_C, with_bot.coe_zero, zero_add, ← with_bot.coe_nsmul,
       nsmul_eq_mul]; simp
    ... ≤ (nat_degree p * nat_degree q : ℕ) : with_bot.coe_le_coe.2 $
      mul_le_mul_of_nonneg_right
        (le_nat_degree_of_ne_zero (mem_support_iff.1 hn))
        (nat.zero_le _))

lemma degree_pos_of_root {p : R[X]} (hp : p ≠ 0) (h : is_root p a) : 0 < degree p :=
lt_of_not_ge $ λ hlt, begin
  have := eq_C_of_degree_le_zero hlt,
  rw [is_root, this, eval_C] at h,
  simp only [h, ring_hom.map_zero] at this,
  exact hp this,
end

lemma nat_degree_le_iff_coeff_eq_zero :
  p.nat_degree ≤ n ↔ ∀ N : ℕ, n < N → p.coeff N = 0 :=
by simp_rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero, with_bot.coe_lt_coe]

lemma nat_degree_add_le_iff_left {n : ℕ} (p q : R[X]) (qn : q.nat_degree ≤ n) :
  (p + q).nat_degree ≤ n ↔ p.nat_degree ≤ n :=
begin
  refine ⟨λ h, _, λ h, nat_degree_add_le_of_degree_le h qn⟩,
  refine nat_degree_le_iff_coeff_eq_zero.mpr (λ m hm, _),
  convert nat_degree_le_iff_coeff_eq_zero.mp h m hm using 1,
  rw [coeff_add, nat_degree_le_iff_coeff_eq_zero.mp qn _ hm, add_zero],
end

lemma nat_degree_add_le_iff_right {n : ℕ} (p q : R[X]) (pn : p.nat_degree ≤ n) :
  (p + q).nat_degree ≤ n ↔ q.nat_degree ≤ n :=
begin
  rw add_comm,
  exact nat_degree_add_le_iff_left _ _ pn,
end

lemma nat_degree_C_mul_le (a : R) (f : R[X]) :
  (C a * f).nat_degree ≤ f.nat_degree :=
calc
  (C a * f).nat_degree ≤ (C a).nat_degree + f.nat_degree : nat_degree_mul_le
  ... = 0 + f.nat_degree : by rw nat_degree_C a
  ... = f.nat_degree : zero_add _

lemma nat_degree_mul_C_le (f : R[X]) (a : R) :
  (f * C a).nat_degree ≤ f.nat_degree :=
calc
  (f * C a).nat_degree ≤ f.nat_degree + (C a).nat_degree : nat_degree_mul_le
  ... = f.nat_degree + 0 : by rw nat_degree_C a
  ... = f.nat_degree : add_zero _

lemma eq_nat_degree_of_le_mem_support (pn : p.nat_degree ≤ n) (ns : n ∈ p.support) :
  p.nat_degree = n :=
le_antisymm pn (le_nat_degree_of_mem_supp _ ns)

lemma nat_degree_C_mul_eq_of_mul_eq_one {ai : R} (au : ai * a = 1) :
  (C a * p).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_C_mul_le a p) (calc
  p.nat_degree = (1 * p).nat_degree : by nth_rewrite 0 [← one_mul p]
  ... = (C ai * (C a * p)).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (C a * p).nat_degree : nat_degree_C_mul_le ai (C a * p))

lemma nat_degree_mul_C_eq_of_mul_eq_one {ai : R} (au : a * ai = 1) :
  (p * C a).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_mul_C_le p a) (calc
  p.nat_degree = (p * 1).nat_degree : by nth_rewrite 0 [← mul_one p]
  ... = ((p * C a) * C ai).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (p * C a).nat_degree : nat_degree_mul_C_le (p * C a) ai)

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_mul_C_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
-/
lemma nat_degree_mul_C_eq_of_mul_ne_zero (h : p.leading_coeff * a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_mul_C_le p a) _,
  refine mem_support_iff.mpr _,
  rwa coeff_mul_C,
end

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_C_mul_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
-/
lemma nat_degree_C_mul_eq_of_mul_ne_zero (h : a * p.leading_coeff ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_C_mul_le a p) _,
  refine mem_support_iff.mpr _,
  rwa coeff_C_mul,
end

lemma nat_degree_add_coeff_mul (f g : R[X]) :
  (f * g).coeff (f.nat_degree + g.nat_degree) = f.coeff f.nat_degree * g.coeff g.nat_degree :=
by simp only [coeff_nat_degree, coeff_mul_degree_add_degree]

lemma nat_degree_lt_coeff_mul (h : p.nat_degree + q.nat_degree < m + n) :
  (p * q).coeff (m + n) = 0 :=
coeff_eq_zero_of_nat_degree_lt (nat_degree_mul_le.trans_lt h)

lemma coeff_mul_of_nat_degree_le (pm : p.nat_degree ≤ m) (qn : q.nat_degree ≤ n) :
  (p * q).coeff (m + n) = p.coeff m * q.coeff n :=
begin
  rcases eq_or_lt_of_le pm with rfl | hm;
  rcases eq_or_lt_of_le qn with rfl | hn,
  { exact nat_degree_add_coeff_mul _ _ },
  { rw [coeff_eq_zero_of_nat_degree_lt hn, mul_zero],
    exact nat_degree_lt_coeff_mul (add_lt_add_left hn _) },
  { rw [coeff_eq_zero_of_nat_degree_lt hm, zero_mul],
    exact nat_degree_lt_coeff_mul (add_lt_add_right hm _) },
  { rw [coeff_eq_zero_of_nat_degree_lt hn, mul_zero],
    exact nat_degree_lt_coeff_mul (add_lt_add hm hn) },
end

lemma coeff_pow_of_nat_degree_le (pn : p.nat_degree ≤ n) :
  (p ^ m).coeff (n * m) = (p.coeff n) ^ m :=
begin
  induction m with m hm,
  { simp },
  { rw [pow_succ', pow_succ', ← hm, nat.mul_succ, coeff_mul_of_nat_degree_le _ pn],
    refine nat_degree_pow_le.trans (le_trans _ (mul_comm _ _).le),
    exact mul_le_mul_of_nonneg_left pn m.zero_le }
end

lemma coeff_add_eq_left_of_lt (qn : q.nat_degree < n) :
  (p + q).coeff n = p.coeff n :=
(coeff_add _ _ _).trans $ (congr_arg _ $ coeff_eq_zero_of_nat_degree_lt $ qn).trans $ add_zero _

lemma coeff_add_eq_right_of_lt (pn : p.nat_degree < n) :
  (p + q).coeff n = q.coeff n :=
by { rw add_comm, exact coeff_add_eq_left_of_lt pn }

lemma nat_degree_sum_eq_of_disjoint (f : S → R[X]) (s : finset S)
  (h : set.pairwise { i | i ∈ s ∧ f i ≠ 0 } (ne on (nat_degree ∘ f))) :
  nat_degree (s.sum f) = s.sup (λ i, nat_degree (f i)) :=
begin
  by_cases H : ∃ x ∈ s, f x ≠ 0,
  { obtain ⟨x, hx, hx'⟩ := H,
    have hs : s.nonempty := ⟨x, hx⟩,
    refine nat_degree_eq_of_degree_eq_some _,
    rw degree_sum_eq_of_disjoint,
    { rw [←finset.sup'_eq_sup hs, ←finset.sup'_eq_sup hs, finset.coe_sup', ←finset.sup'_eq_sup hs],
      refine le_antisymm _ _,
      { rw finset.sup'_le_iff,
        intros b hb,
        by_cases hb' : f b = 0,
        { simpa [hb'] using hs },
        rw degree_eq_nat_degree hb',
        exact finset.le_sup' _ hb },
      { rw finset.sup'_le_iff,
        intros b hb,
        simp only [finset.le_sup'_iff, exists_prop, function.comp_app],
        by_cases hb' : f b = 0,
        { refine ⟨x, hx, _⟩,
          contrapose! hx',
          simpa [hb', degree_eq_bot] using hx' },
        exact ⟨b, hb, (degree_eq_nat_degree hb').ge⟩ } },
    { exact h.imp (λ x y hxy hxy', hxy (nat_degree_eq_of_degree_eq hxy')) } },
  { push_neg at H,
    rw [finset.sum_eq_zero H, nat_degree_zero, eq_comm, show 0 = ⊥, from rfl,
        finset.sup_eq_bot_iff],
    intros x hx,
    simp [H x hx] }
end

lemma nat_degree_bit0 (a : R[X]) : (bit0 a).nat_degree ≤ a.nat_degree :=
(nat_degree_add_le _ _).trans (max_self _).le

lemma nat_degree_bit1 (a : R[X]) : (bit1 a).nat_degree ≤ a.nat_degree :=
(nat_degree_add_le _ _).trans (by simp [nat_degree_bit0])

variables [semiring S]

lemma nat_degree_pos_of_eval₂_root {p : R[X]} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < nat_degree p :=
lt_of_not_ge $ λ hlt, begin
  have A : p = C (p.coeff 0) := eq_C_of_nat_degree_le_zero hlt,
  rw [A, eval₂_C] at hz,
  simp only [inj (p.coeff 0) hz, ring_hom.map_zero] at A,
  exact hp A
end

lemma degree_pos_of_eval₂_root {p : R[X]} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < degree p :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos_of_eval₂_root hp f hz inj)

@[simp] lemma coe_lt_degree {p : R[X]} {n : ℕ} :
  ((n : with_bot ℕ) < degree p) ↔ n < nat_degree p :=
begin
  by_cases h : p = 0,
  { simp [h] },
  rw [degree_eq_nat_degree h, with_bot.coe_lt_coe],
end

end degree
end semiring

section ring

variables [ring R] {p q : R[X]}

lemma nat_degree_sub : (p - q).nat_degree = (q - p).nat_degree :=
by rw [← nat_degree_neg, neg_sub]

lemma nat_degree_sub_le_iff_left (qn : q.nat_degree ≤ n) :
  (p - q).nat_degree ≤ n ↔ p.nat_degree ≤ n :=
begin
  rw ← nat_degree_neg at qn,
  rw [sub_eq_add_neg, nat_degree_add_le_iff_left _ _ qn],
end

lemma nat_degree_sub_le_iff_right (pn : p.nat_degree ≤ n) :
  (p - q).nat_degree ≤ n ↔ q.nat_degree ≤ n :=
by rwa [nat_degree_sub, nat_degree_sub_le_iff_left]

lemma coeff_sub_eq_left_of_lt (dg : q.nat_degree < n) :
  (p - q).coeff n = p.coeff n :=
begin
  rw ← nat_degree_neg at dg,
  rw [sub_eq_add_neg, coeff_add_eq_left_of_lt dg],
end

lemma coeff_sub_eq_neg_right_of_lt (df : p.nat_degree < n) :
  (p - q).coeff n = - q.coeff n :=
by rwa [sub_eq_add_neg, coeff_add_eq_right_of_lt, coeff_neg]

end ring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : R[X]}

lemma degree_mul_C (a0 : a ≠ 0) :
  (p * C a).degree = p.degree :=
by rw [degree_mul, degree_C a0, add_zero]

lemma degree_C_mul (a0 : a ≠ 0) :
  (C a * p).degree = p.degree :=
by rw [degree_mul, degree_C a0, zero_add]

lemma nat_degree_mul_C (a0 : a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
by simp only [nat_degree, degree_mul_C a0]

lemma nat_degree_C_mul (a0 : a ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
by simp only [nat_degree, degree_C_mul a0]

lemma nat_degree_comp : nat_degree (p.comp q) = nat_degree p * nat_degree q :=
begin
  by_cases q0 : q.nat_degree = 0,
  { rw [degree_le_zero_iff.mp (nat_degree_eq_zero_iff_degree_le_zero.mp q0), comp_C, nat_degree_C,
      nat_degree_C, mul_zero] },
  { by_cases p0 : p = 0, { simp only [p0, zero_comp, nat_degree_zero, zero_mul] },
    refine le_antisymm nat_degree_comp_le (le_nat_degree_of_ne_zero _),
    simp only [coeff_comp_degree_mul_degree q0, p0, mul_eq_zero, leading_coeff_eq_zero, or_self,
      ne_zero_of_nat_degree_gt (nat.pos_of_ne_zero q0), pow_ne_zero, ne.def, not_false_iff] }
end

@[simp] theorem nat_degree_iterate_comp (k : ℕ) :
  (p.comp^[k] q).nat_degree = p.nat_degree ^ k * q.nat_degree :=
begin
  induction k with k IH,
  { simp },
  { rw [function.iterate_succ_apply', nat_degree_comp, IH, pow_succ, mul_assoc] }
end

lemma leading_coeff_comp (hq : nat_degree q ≠ 0) :
  leading_coeff (p.comp q) = leading_coeff p * leading_coeff q ^ nat_degree p :=
by rw [← coeff_comp_degree_mul_degree hq, ← nat_degree_comp, coeff_nat_degree]

end no_zero_divisors

end polynomial